Commit 6562a126e298facb4c4e4e26b081d30add70371a Parent: c20a13d6002297673ba7ecb369154d8475647728 Author: mcol <mcol@posteo.net> Date: 2022-05-29 14:52:13 +0100 Committer: mcol <mcol@posteo.net> Committed: 2022-05-29 14:52:13 +0100 Lookup rewrite checkpoint
src/Templates.hs Modified
@@ -5,9 +5,13 @@ Template (..), loadTemplate, generate, + generateIndex, ) where +import Control.Monad.IO.Unlift import qualified Data.HashMap.Strict as HashMap +import Control.Monad.Trans.Reader (ReaderT) +import Control.Monad.IO.Class (liftIO) import Data.IORef (modifyIORef', newIORef, readIORef) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -15,10 +19,10 @@ import Path (Abs, File, Path, Rel, filename, toFilePath) import System.IO.Error (tryIOError) import qualified Text.Ginger.AST as G -import Text.Ginger.GVal (GVal) +import Text.Ginger.GVal (GVal, toGVal) import Text.Ginger.Html (Html, htmlSource) import Text.Ginger.Parse (ParserError (..), SourcePos, parseGingerFile) -import Text.Ginger.Run (easyContext, runGingerT) +import Text.Ginger.Run import Types @@ -53,15 +57,62 @@ This is the generator function that receives variables and uses Ginger to render templates into Text. -} +generateIndex :: + Template -> + HashMap.HashMap T.Text (GVal RunRepo) -> + IO TL.Text +generateIndex template scope = do + ioref <- newIORef . TB.fromText $ "" + + let emit :: Html -> IO () + emit = modifyIORef' ioref . flip mappend . TB.fromText . htmlSource + + context = makeContextHtmlM (scopeLookup scope) emit + + runGingerT context (templateGinger template) + TB.toLazyText <$> readIORef ioref + + where + scopeLookup :: + HashMap.HashMap T.Text (GVal RunRepo) -> + T.Text -> + RunRepo (GVal RunRepo) + scopeLookup scope' key = do + case key of + "file" -> + return $ toGVal ("file" :: String) + _ -> + return $ toGVal $ HashMap.lookup key scope' + + +{- +This is the generator function that receives variables and uses Ginger to render +templates into Text. +-} generate :: + (T.Text -> RunRepo (GVal RunRepo)) -> Template -> HashMap.HashMap T.Text (GVal RunRepo) -> IO TL.Text -generate template scope = do +generate repoLookup template scope = do ioref <- newIORef . TB.fromText $ "" let emit :: Html -> IO () emit = modifyIORef' ioref . flip mappend . TB.fromText . htmlSource - runGingerT (easyContext emit scope) (templateGinger template) + context = makeContextHtmlM repoLookup emit + + runGingerT context (templateGinger template) TB.toLazyText <$> readIORef ioref + + --where + --scopeLookup :: + -- HashMap.HashMap T.Text (GVal RunRepo) -> + -- T.Text -> + -- RunRepo (GVal RunRepo) + --scopeLookup scope' key = do + -- case key of + -- "fileeeeeeeeeee" -> + -- return $ toGVal ("file" :: String) + -- _ -> + -- return $ toGVal $ HashMap.lookup key scope'
src/Repositories.hs Modified
@@ -7,8 +7,10 @@ module Repositories ( run, + getRefs, ) where +import Control.Monad.IO.Unlift import qualified Bindings.Libgit2 as LG import Conduit (runConduit, sinkList, (.|)) import Control.Exception (try) @@ -137,14 +139,13 @@ liftIO . ensureDir $ output </> fileDir -- Run the generator -- - liftIO $ mapM_ (genRepo output scope) $ envRepoTemplates env - let quiet = envQuiet env force = envForce env -- This annotation blocks the first use of gen from making t concrete gen :: ToGVal RunRepo t => + (T.Text -> RunRepo (GVal RunRepo)) -> Template -> T.Text -> Path Abs Dir -> @@ -153,13 +154,17 @@ IO () gen = genTarget scope quiet force - whenJust (envCommitTemplate env) \commitT -> liftIO do - output' <- fmap (output </>) . parseRelDir $ "commit" - mapM_ (gen commitT "commit" output' commitHref) commits + withRunInIO \runInIO -> mapM_ (genRepo (repoLookup runInIO) output scope) (envRepoTemplates env) + + whenJust (envCommitTemplate env) \commitT -> + withRunInIO \runInIO -> do + output' <- fmap (output </>) . parseRelDir $ "commit" + mapM_ (gen (repoLookup runInIO) commitT "commit" output' commitHref) commits - whenJust (envFileTemplate env) \fileT -> liftIO do - output' <- fmap (output </>) . parseRelDir $ "file" - mapM_ (gen fileT "file" output' fileHref) tree -- TODO: detect file changes + whenJust (envFileTemplate env) \fileT -> + withRunInIO \runInIO -> do + output' <- fmap (output </>) . parseRelDir $ "file" + mapM_ (gen (repoLookup runInIO) fileT "file" output' fileHref) tree -- TODO: detect file changes -- Copy any static files/folders into the output folder -- liftIO . envRepoCopyStatics env $ output @@ -364,13 +369,14 @@ dropName Nothing _ = Nothing genRepo :: + (T.Text -> RunRepo (GVal RunRepo)) -> Path Abs Dir -> HashMap.HashMap T.Text (GVal RunRepo) -> Template -> IO () -genRepo output scope template = +genRepo repoLookup output scope template = let output' = toFilePath (output </> templatePath template) - in TL.writeFile output' =<< generate template scope + in TL.writeFile output' =<< generate repoLookup template scope ---------------------------------------------------------------------------------------- -- Targets ----------------------------------------------------------------------------- @@ -393,17 +399,28 @@ HashMap.HashMap T.Text (GVal RunRepo) -> Bool -> Bool -> + (T.Text -> RunRepo (GVal RunRepo)) -> Template -> T.Text -> Path Abs Dir -> (t -> FilePath) -> t -> IO () -genTarget scope quiet force template category output href target = do +genTarget scope quiet force repoLookup template category output href target = do output' <- fmap (output </>) . parseRelFile . href $ target exists <- doesFileExist output' when (force || not exists) $ do let output'' = toFilePath output' scope' = HashMap.insert category (toGVal target) scope unless quiet . putStrLn $ "Writing " <> output'' - TL.writeFile output'' =<< generate template scope' + TL.writeFile output'' =<< generate repoLookup template scope' + + +-- This loads data from the git repository +repoLookup :: + (ReaderT LgRepo IO (GVal RunRepo) -> IO (GVal RunRepo)) -> + T.Text -> + RunRepo (GVal RunRepo) +repoLookup runInIO key = liftIO . runInIO $ case key of + "tags" -> toGVal <$> getRefs "refs/tags/" + key' -> return . toGVal $ key'
src/Index.hs Modified
@@ -7,13 +7,14 @@ import Control.Monad (unless) import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as T +import qualified Data.Text.IO as T import qualified Data.Text.Lazy.IO as TL import Path (toFilePath) import System.FilePath (combine) import Text.Ginger.GVal (GVal, toGVal) import Env (Env (..)) -import Templates (Template (..), generate) +import Templates (Template (..), generateIndex) import Types {- @@ -27,7 +28,7 @@ runIndexFile env repos template = do let output = combine (toFilePath . envOutput $ env) . toFilePath . templatePath $ template unless (envQuiet env) . putStrLn $ "Writing " <> output - TL.writeFile output =<< generate template (packageIndex env repos) + TL.writeFile output =<< generateIndex template (packageIndex env repos) {- This packages the variables that are available inside the index scope.
gitserve.cabal Modified
@@ -39,5 +39,6 @@ , tagged , text , transformers + , unliftio-core , unordered-containers , utf8-string