Commit 2cdfc7332b46fe5d9a8c602e055e8a7239031024 Parent: 20645a2fd7201ab9bb7f2b7b820d1afd8e43f138 Author: mcol <mcol@posteo.net> Date: 2021-11-24 19:44:44 +0000 Committer: mcol <mcol@posteo.net> Committed: 2021-11-24 20:18:53 +0000 move ginger parser into git repository monad context
src/Types.hs Modified
@@ -10,6 +10,7 @@ module Types where +import Control.Monad.Trans.Reader (ReaderT) import Data.ByteString.UTF8 (toString) import Data.Default (def) import Data.Maybe (listToMaybe) @@ -22,7 +23,9 @@ import Git.Libgit2 (LgRepo) import System.FilePath (takeFileName) import Text.Ginger.GVal (GVal, ToGVal, asBoolean, asHtml, asList, asLookup, asText, toGVal) -import Text.Ginger.Html (html) +import Text.Ginger.Html (Html, html) +import Text.Ginger.Parse (SourcePos) +import Text.Ginger.Run (Run) {- GVal implementation for a repository, accessed in the scope of an individual repository, @@ -126,8 +129,8 @@ GVal implementations for data definitions above, allowing commits to be rendered in Ginger templates. -} -instance ToGVal m TreeFile where - toGVal :: TreeFile -> GVal m +instance ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) TreeFile where + toGVal :: TreeFile -> GVal (Run SourcePos (ReaderT LgRepo IO) Html) toGVal treefile = def { asHtml = html . pack . toString . treeFilePath $ treefile @@ -136,8 +139,8 @@ , asBoolean = True -- Used for conditionally checking readme/license template variables. } -instance ToGVal m TreeFileContents where - toGVal :: TreeFileContents -> GVal m +instance ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) TreeFileContents where + toGVal :: TreeFileContents -> GVal (Run SourcePos (ReaderT LgRepo IO) Html) toGVal (FileContents text) = toGVal text toGVal (FolderContents treeFiles) = def @@ -146,7 +149,7 @@ , asList = Just . fmap toGVal $ treeFiles } -treeAsLookup :: TreeFile -> Text -> Maybe (GVal m) +treeAsLookup :: TreeFile -> Text -> Maybe (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) treeAsLookup treefile = \case "path" -> Just . toGVal . treeFilePath $ treefile "href" -> Just . toGVal . treePathToHref . treeFilePath $ treefile
src/Templates.hs Modified
@@ -20,11 +20,14 @@ ) where import Control.Monad (void, (<=<)) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.Reader (ReaderT) import Data.Char (toLower) import qualified Data.HashMap.Strict as HashMap import Data.List (isSuffixOf) import Data.Maybe (catMaybes) import Data.Text (Text, unpack) +import Git.Libgit2 (LgRepo) import Path (Abs, Dir, File, Path, dirname, filename, parseAbsDir, toFilePath, (</>)) import Path.IO (copyDirRecur, copyFile, ensureDir, listDir) import System.Directory (makeAbsolute) @@ -85,12 +88,12 @@ -} generate :: FilePath -> - HashMap.HashMap Text (GVal (Run SourcePos IO Html)) -> + HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) -> Template -> - IO () + ReaderT LgRepo IO () generate output context template = do - writeFile output "" -- Clear contents of file if it exists - void $ runGingerT (easyContext (writeTo output) context) . templateGinger $ template + liftIO $ writeFile output "" -- Clear contents of file if it exists + void . runGingerT (easyContext (writeTo output) context) . templateGinger $ template ---------------------------------------------------------------------------------------- -- Private ----------------------------------------------------------------------------- @@ -166,5 +169,5 @@ {- This function gets the output HTML data and is responsible for saving it to file. -} -writeTo :: FilePath -> Html -> IO () -writeTo path = appendFile path . unpack . htmlSource +writeTo :: FilePath -> Html -> ReaderT LgRepo IO () +writeTo path = liftIO . appendFile path . unpack . htmlSource
src/Repositories.hs Modified
@@ -93,9 +93,9 @@ -- Run the generator -- let force = envForce env - liftIO . mapM_ (genRepo output scope) $ envTemplates env - liftIO . mapM_ (genTarget output scope force $ envCommitTemplate env) $ commits - liftIO . mapM_ (genTarget output scope True $ envFileTemplate env) $ tree -- TODO: detect file changes + mapM_ (genRepo output scope) $ envTemplates env + mapM_ (genTarget output scope force $ envCommitTemplate env) commits + mapM_ (genTarget output scope True $ envFileTemplate env) tree -- TODO: detect file changes -- Return the repo with the head so the index page can use it. -- return $ repo{repositoryHead = Just . head $ commits} @@ -114,7 +114,7 @@ [TreeFile] -> [Ref] -> [Ref] -> - HashMap.HashMap Text (GVal (Run SourcePos IO Html)) + HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) package env name description commits tree tags branches = HashMap.fromList [ ("host", toGVal . host . envConfig $ env) @@ -204,9 +204,9 @@ genRepo :: FilePath -> - HashMap.HashMap Text (GVal (Run SourcePos IO Html)) -> + HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) -> Template -> - IO () + ReaderT LgRepo IO () genRepo output scope template = generate output' scope template where output' = (</>) output . takeFileName . templatePath $ template @@ -221,7 +221,7 @@ commitTemplate. The Target class generalises how each target is represented so that genTarget can work on any target type. -} -class ToGVal (Run SourcePos IO Html) a => Target a where +class ToGVal (Run SourcePos (ReaderT LgRepo IO) Html) a => Target a where identify :: a -> FilePath category :: a -> FilePath @@ -236,16 +236,16 @@ genTarget :: Target a => FilePath -> - HashMap.HashMap Text (GVal (Run SourcePos IO Html)) -> + HashMap.HashMap Text (GVal (Run SourcePos (ReaderT LgRepo IO) Html)) -> Bool -> Maybe Template -> a -> - IO () + ReaderT LgRepo IO () genTarget _ _ _ Nothing _ = return () genTarget output scope force (Just template) target = do let output' = output </> category target </> identify target - exists <- doesFileExist output' + exists <- liftIO . doesFileExist $ output' when (force || not exists) $ do - putStrLn $ "Writing " <> output' + liftIO $ putStrLn $ "Writing " <> output' let scope' = scope <> HashMap.fromList [(pack . category $ target, toGVal target)] generate output' scope' template
src/Index.hs Modified
@@ -4,13 +4,14 @@ runIndex, ) where +import Control.Monad (void) import qualified Data.HashMap.Strict as HashMap -import Data.Text (Text) +import Data.Text (Text, unpack) import System.FilePath ((</>)) import Text.Ginger.GVal (GVal, toGVal) -import Text.Ginger.Html (Html) +import Text.Ginger.Html (Html, htmlSource) import Text.Ginger.Parse (SourcePos) -import Text.Ginger.Run (Run) +import Text.Ginger.Run (Run, easyRenderM) import Config import Templates @@ -25,13 +26,16 @@ case envIndexTemplate env of Nothing -> return () - Just template -> - generate - (outputDirectory config </> "index.html") - (packageIndex config repos) - template + Just template -> do + writeFile output "" -- Clear contents of file if it exists + void $ + easyRenderM + (appendFile output . unpack . htmlSource) + (packageIndex config repos) + (templateGinger template) where config = envConfig env + output = outputDirectory config </> "index.html" ---------------------------------------------------------------------------------------- -- Private -----------------------------------------------------------------------------