Commit 32b4a293e4b61c388dd3c7112d1ca57482ae4025 Parent: 5fb5632025430b5e4dd9f126300c39d7f24492c6 Author: mcol <mcol@posteo.net> Date: 2021-09-24 11:10:46 +0100 Committer: mcol <mcol@posteo.net> Committed: 2021-09-24 11:10:46 +0100 Let hashmap accept other GVals and add instance for commits
src/Templates.hs Modified
@@ -17,7 +17,7 @@ import System.FilePath ((</>)) import System.IO.Error (tryIOError) import qualified Text.Ginger.AST as G -import qualified Text.Ginger.Parse as G +import Text.Ginger.Parse (SourcePos, parseGingerFile) import Text.Ginger.GVal (GVal) import Text.Ginger.Html (htmlSource, Html) import Text.Ginger.Run (easyRenderM, Run, RuntimeError) @@ -26,7 +26,7 @@ data Template = Template { templatePath :: FilePath - , templateGinger :: G.Template G.SourcePos + , templateGinger :: G.Template SourcePos } {- @@ -36,7 +36,7 @@ loadTemplates :: Config -> IO [Template] loadTemplates config = do files <- getFiles config - parsed <- sequence $ G.parseGingerFile includeResolver <$> files + parsed <- sequence $ parseGingerFile includeResolver <$> files return $ Template <$> files <*> rights parsed ---------------------------------------------------------------------------------------- @@ -87,7 +87,7 @@ Ginger to render templates using them. -} generate - :: HashMap.HashMap Text Text + :: HashMap.HashMap Text (GVal (Run SourcePos IO Html)) -> Template - -> IO (Either (RuntimeError G.SourcePos) (GVal (Run G.SourcePos IO Html))) + -> IO (Either (RuntimeError SourcePos) (GVal (Run SourcePos IO Html))) generate context template = easyRenderM writeTo context (templateGinger template)
src/Repositories.hs Modified
@@ -1,5 +1,7 @@ {-# Language LambdaCase #-} {-# Language OverloadedStrings #-} -- Needed for resolveReference +{-# Language FlexibleInstances #-} -- Needed for `instance ToGVal` +{-# Language MultiParamTypeClasses #-} -- Needed for `instance ToGVal` module Repositories ( run @@ -9,6 +11,7 @@ import Control.Monad ((<=<)) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader (ReaderT) +import Data.Default (def) import Data.Either (fromRight) import Data.Tagged import Data.Text (pack, Text) @@ -18,6 +21,10 @@ import System.Directory (createDirectoryIfMissing) import System.FilePath ((</>), takeFileName) import System.IO.Error (tryIOError) +import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml) +import Text.Ginger.Html (Html, html) +import Text.Ginger.Run (Run) +import Text.Ginger.Parse (SourcePos) import qualified Data.HashMap.Strict as HashMap import Config (Config, repoPaths, outputDirectory, host) @@ -82,13 +89,13 @@ -> Text -> [Commit LgRepo] -> [(TreeFilePath, TreeEntry r)] - -> HashMap.HashMap Text Text + -> HashMap.HashMap Text (GVal (Run SourcePos IO Html)) package config name description commits tree = HashMap.fromList - [ ("host", host config) - , ("name", pack name) - , ("description", description) - , ("commits", "commits") - , ("tree", "tree") + [ ("host", toGVal $ host config) + , ("name", toGVal $ pack name) + , ("description", toGVal description) + , ("commits", toGVal commits) + , ("tree", toGVal ("tree" :: String)) ] getCommits :: CommitOid LgRepo -> ReaderT LgRepo IO [Commit LgRepo] @@ -105,3 +112,9 @@ getDescription :: FilePath -> IO Text getDescription path = fromRight "" <$> tryIOError (pack <$> readFile path) + +instance ToGVal m (Commit LgRepo) where + toGVal x = def + { asHtml = html . pack . show . commitLog $ x + , asText = pack . show . commitLog $ x + }
gitserve.cabal Modified
@@ -20,6 +20,7 @@ default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , conduit + , data-default , dhall , directory , filepath