🐙 Templated web page generator for your git repositories
git clone https://github.com/m-col/gitja
Files | Refs | Readme | License

Commit c14e055279cd1c301f34c4612bc5e733ade27ef9
Parent: d6bf4e85560006fe1ff289db1d6923c194bfbcd9
Author: mcol <mcol@posteo.net>
Date: 2021-10-01 00:04:42 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2021-10-01 00:04:42 +0100

Move index-related code into own module

src/Repositories.hs Modified

@@ -1,12 +1,13 @@
 {-# Language LambdaCase #-}
-{-# Language OverloadedStrings #-}  -- Needed for resolveReference
+{-# Language OverloadedStrings #-}
 {-# Language FlexibleInstances #-}  -- Needed for `instance ToGVal`
 {-# Language MultiParamTypeClasses #-}  -- Needed for `instance ToGVal`
 {-# Language InstanceSigs #-}  -- Needed for toGVal type signature
 {-# Language FlexibleContexts #-}  -- Needed for the Target class type constraints
 
 module Repositories (
-    run
+    run,
+    getDescription  -- Used by Index.hs::runINdex
 ) where
 
 import Conduit (runConduit, (.|), sinkList)
@@ -41,7 +42,14 @@
 run :: Env -> IO ()
 run env = do
     foldMap (processRepo env) . repoPaths . envConfig $ env  -- TODO: make concurrent
-    runIndex env
+    return ()
+
+{-
+Pass the repository's folder, get its description. This is export so that Index.hs can
+use it too.
+-}
+getDescription :: FilePath -> IO Text
+getDescription = fmap (fromRight "") . tryIOError . fmap pack . readFile . flip (</>) "description"
 
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
@@ -122,10 +130,6 @@
     entries <- listTreeEntries =<< lookupTree . commitTree =<< lookupCommit commitID
     return $ uncurry TreeFile <$> entries
 
--- Pass the repository's folder, get its description.
-getDescription :: FilePath -> IO Text
-getDescription = fmap (fromRight "") . tryIOError . fmap pack . readFile . flip (</>) "description"
-
 {-
 Here we define how commits can be accessed and represented in Ginger templates.
 -}
@@ -173,58 +177,12 @@
 ----------------------------------------------------------------------------------------
 
 {-
-This creates the main index file from the index template, using information from all
-configured respositories.
+A Target refers to a template scope and repository object whose information is available
+in that scope. For example, commits are a target as they each generate a scope
+containing that commit's information, and these scopes are each rendered in the
+commitTemplate. The Target class generalises how each target is represented so that
+genTarget can work on any target type.
 -}
-runIndex :: Env -> IO ()
-runIndex env =
-    case envIndexTemplate env of
-        Nothing ->
-            return ()
-        Just template -> do
-            let config = envConfig env
-            let paths = repoPaths config
-            descriptions <- mapM getDescription paths
-            let repos = zipWith ($) (Repo . takeFileName <$> paths) descriptions
-            let indexScope = packageIndex config repos
-            generate (outputDirectory config) indexScope (template { templatePath = "index.html" })
-            return ()
-
-packageIndex
-    :: Config
-    -> [Repo]
-    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-packageIndex config repos = HashMap.fromList
-    [ ("host", toGVal $ host config)
-    , ("repositories", toGVal repos)
-    ]
-
-{-
-The index template can access variables in the index scope. The primary variable here is
-the list of repositories, which can be looped over and each repo entry has some
-properties that can be accessed. These are defined here.
--}
-data Repo = Repo
-    { repoName :: FilePath
-    , repoDescription :: Text
-    }
-
-instance ToGVal m Repo where
-    toGVal :: Repo -> GVal m
-    toGVal repo = def
-        { asHtml = html . pack . show . repoName $ repo
-        , asText = pack . show . repoName $ repo
-        , asLookup = Just . repoAsLookup $ repo
-        }
-
-repoAsLookup :: Repo -> Text -> Maybe (GVal m)
-repoAsLookup repo = \case
-    "name" -> Just . toGVal . repoName $ repo
-    "description" -> Just . toGVal . repoDescription $ repo
-    _ -> Nothing
-
-----------------------------------------------------------------------------------------
-
 class ToGVal (Run SourcePos IO Html) a => Target a where
     identify :: a -> String
     category :: a -> FilePath

src/Main.hs Modified

@@ -5,8 +5,12 @@
 ) where
 
 import Config (getConfig)
+import Index (runIndex)
 import Templates (loadTemplates)
 import Repositories (run)
 
 main :: IO ()
-main = getConfig "./config.dhall" >>= loadTemplates >>= run
+main = do
+    env <- loadTemplates =<< getConfig "./config.dhall"
+    runIndex env
+    run env

src/Index.hs Added

@@ -0,0 +1,80 @@
+{-# Language LambdaCase #-}
+{-# Language OverloadedStrings #-}
+{-# Language FlexibleInstances #-}  -- Needed for `instance ToGVal`
+{-# Language MultiParamTypeClasses #-}  -- Needed for `instance ToGVal`
+{-# Language InstanceSigs #-}  -- Needed for toGVal type signature
+
+module Index (
+    runIndex
+) where
+
+import Data.Default (def)
+import Data.Text (pack, Text)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeFileName)
+import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml, asLookup)
+import Text.Ginger.Html (Html, html)
+import Text.Ginger.Parse (SourcePos)
+import Text.Ginger.Run (Run)
+import qualified Data.HashMap.Strict as HashMap
+
+import Config
+import Repositories
+import Templates
+
+{-
+This creates the main index file from the index template, using information from all
+configured respositories.
+-}
+runIndex :: Env -> IO ()
+runIndex env =
+    case envIndexTemplate env of
+        Nothing ->
+            return ()
+        Just template -> do
+            let config = envConfig env
+            createDirectoryIfMissing True $ outputDirectory config
+            let paths = repoPaths config
+            descriptions <- mapM getDescription paths
+            let repos = zipWith ($) (Repo . takeFileName <$> paths) descriptions
+            let scope = packageIndex config repos
+            generate (outputDirectory config) scope (template { templatePath = "index.html" })
+            return ()
+
+----------------------------------------------------------------------------------------
+-- Private -----------------------------------------------------------------------------
+
+{-
+This packages the variables that are available inside the index template.
+-}
+packageIndex
+    :: Config
+    -> [Repo]
+    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
+packageIndex config repos = HashMap.fromList
+    [ ("host", toGVal $ host config)
+    , ("repositories", toGVal repos)
+    ]
+
+{-
+The unique variable in the index scope is the list of repositories, which can be looped
+over and each entry has some properties that can be accessed. Those are defined here.
+-}
+data Repo = Repo
+    { repoName :: FilePath
+    , repoDescription :: Text
+    }
+
+instance ToGVal m Repo where
+    toGVal :: Repo -> GVal m
+    toGVal repo = def
+        { asHtml = html . pack . show . repoName $ repo
+        , asText = pack . show . repoName $ repo
+        , asLookup = Just . repoAsLookup $ repo
+        }
+
+repoAsLookup :: Repo -> Text -> Maybe (GVal m)
+repoAsLookup repo = \case
+    "name" -> Just . toGVal . repoName $ repo
+    "description" -> Just . toGVal . repoDescription $ repo
+    _ -> Nothing

gitserve.cabal Modified

@@ -16,7 +16,7 @@
 executable gitserve
   hs-source-dirs:      src
   main-is:             Main.hs
-  other-modules:       Config, Repositories, Templates
+  other-modules:       Config, Index, Repositories, Templates
   default-language:    Haskell2010
   build-depends:       base >= 4.7 && < 5
                      , conduit