src/Templates.hs Modified

@@ -2,44 +2,22 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Templates (
-    Env (..),
     Template (..),
-    loadEnv,
+    loadTemplate,
     generate,
 ) where
 
-import Control.Monad (filterM, join, when, (<=<))
-import Control.Monad.Extra (findM)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
 import qualified Data.HashMap.Strict as HashMap
 import Data.IORef (modifyIORef', newIORef, readIORef)
-import Data.Maybe (catMaybes, fromMaybe, isNothing)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.Builder as TB
 import qualified Data.Text.Lazy.IO as T
 import Git.Libgit2 (LgRepo)
-import Path (Abs, Dir, File, Path, Rel, dirname, filename, parseAbsDir, toFilePath, (</>))
-import Path.IO (
-    copyDirRecur,
-    copyFile,
-    doesDirExist,
-    ensureDir,
-    forgivingAbsence,
-    ignoringAbsence,
-    isSymlink,
-    listDir,
- )
-import System.Directory (
-    canonicalizePath,
-    createDirectoryLink,
-    createFileLink,
-    getSymbolicLinkTarget,
-    pathIsSymbolicLink,
-    removeFile,
- )
-import System.Exit (die)
-import qualified System.FilePath as FP
+import Path (Abs, File, Path, Rel, filename, toFilePath)
+import Path.IO (ignoringAbsence)
+import System.Directory (removeFile)
 import System.IO.Error (tryIOError)
 import qualified Text.Ginger.AST as G
 import Text.Ginger.GVal (GVal)
@@ -47,109 +25,34 @@
 import Text.Ginger.Parse (ParserError (..), SourcePos, parseGingerFile)
 import Text.Ginger.Run (easyContext, runGingerT)
 
-import Config (Config (..))
 import Types
 
-{-
-The Env data type represents all of the program's state, including user configuration
-and loaded template data. This can be accessed as immutable global state at any point.
--}
-data Env = Env
-    { envConfig :: Config
-    , envIndexTemplates :: [Template]
-    , envCommitTemplate :: Maybe Template
-    , envFileTemplate :: Maybe Template
-    , envRepoTemplates :: [Template]
-    , envOutput :: Path Abs Dir
-    , envRepos :: [Path Abs Dir]
-    , envHost :: T.Text
-    , envQuiet :: Bool
-    , envForce :: Bool
-    }
-
 data Template = Template
     { templatePath :: Path Rel File
     , templateGinger :: G.Template SourcePos
     }
 
 {-
-This creates the runtime environment, collecting the config and loading template data
-from the template directory.
+This tries to load a `Template` from the given file path.
 -}
-loadEnv :: Bool -> Bool -> Config -> IO Env
-loadEnv quiet force config = do
-    -- First ensure that the output directory exists
-    output <- parseAbsDir <=< canonicalizePath . confOutput $ config
-    ensureDir output
-
-    -- Parse repos for env
-    repos <-
-        if confScan config
-            then do
-                ps <- fmap concat . mapM (fmap fst . ls) . confRepos $ config
-                return . filter ((/=) ".git" . toFilePath . dirname) $ ps
-            else mapM (parseAbsDir <=< canonicalizePath) . confRepos $ config
-
-    -- Find template files, copying the static files as is
-    (dirs, files) <- ls . confTemplate $ config
-    (_, filesRepo) <- ls $ confTemplate config FP.</> "repo"
-    copyStaticDirs output dirs
-    copyStaticFiles output files
-
-    -- Load files from template directory
-    indexT <- collectTemplates files
-    commitT <- findTemplate "commit.html" filesRepo
-    fileT <- findTemplate "file.html" filesRepo
-    repoT <-
-        collectTemplates
-            . filter (flip notElem ["commit.html", "file.html"] . toFilePath . filename)
-            $ filesRepo
-
-    -- Exit early if we didn't find any templates
-    when
-        ( null indexT
-            && isNothing commitT
-            && isNothing fileT
-            && null repoT
-        )
-        $ die "No templates were found."
-
-    -- App environment
-    return
-        Env
-            { envConfig = config
-            , envIndexTemplates = indexT
-            , envCommitTemplate = commitT
-            , envFileTemplate = fileT
-            , envRepoTemplates = repoT
-            , envOutput = output
-            , envRepos = repos
-            , envHost = confHost config
-            , envQuiet = quiet
-            , envForce = force
-            }
+loadTemplate :: Path Abs File -> IO (Maybe Template)
+loadTemplate path =
+    parseGingerFile includeResolver (toFilePath path) >>= \case
+        Right parsed -> return . Just . Template (filename path) $ parsed
+        Left err -> do
+            informError (toFilePath path) err
+            return Nothing
   where
-    ls :: FilePath -> IO ([Path Abs Dir], [Path Abs File])
-    ls dir = do
-        canon <- parseAbsDir =<< canonicalizePath dir
-        exists <- doesDirExist canon
-        if exists
-            then listDir canon
-            else return ([], [])
-
-    collectTemplates :: [Path Abs File] -> IO [Template]
-    collectTemplates = fmap catMaybes . mapM loadTemplate <=< filterM isMatch
-      where
-        isMatch p = do
-            ((FP.takeExtension . toFilePath $ p) == ".html" &&)
-                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+    -- An attempt at pretty printing the error message.
+    informError p (ParserError msg Nothing) =
+        putStr $ "Template error: " <> p <> "\n" <> indent msg
+    informError p (ParserError msg (Just pos)) =
+        putStrLn $ "Template error: " <> p <> "\n" <> indent (show pos <> "\n" <> msg)
+    indent = unlines . map (mappend "    ") . lines
 
-    findTemplate :: FilePath -> [Path Abs File] -> IO (Maybe Template)
-    findTemplate name = fmap join . mapM loadTemplate <=< findM isMatch
-      where
-        isMatch p =
-            ((toFilePath . filename $ p) == name &&)
-                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+    -- This resolves template 'includes'.
+    includeResolver :: FilePath -> IO (Maybe String)
+    includeResolver p = either (const Nothing) Just <$> tryIOError (readFile p)
 
 {-
 This is the generator function that receives repository-specific variables and uses
@@ -171,73 +74,3 @@
     runGingerT (easyContext emit context) . templateGinger $ template
     result <- liftIO . readIORef $ content
     liftIO . T.writeFile output' . TB.toLazyText $ result
-
-{-
-This takes the session's `Config` and maybe returns a loaded template for the
-``indexTemplate`` setting.
--}
-loadTemplate :: Path Abs File -> IO (Maybe Template)
-loadTemplate path =
-    parseGingerFile includeResolver (toFilePath path) >>= \case
-        Right parsed -> return . Just . Template (filename path) $ parsed
-        Left err -> do
-            informError (toFilePath path) err
-            return Nothing
-  where
-    -- An attempt at pretty printing the error message.
-    informError p (ParserError msg Nothing) =
-        putStr $ "Template error: " <> p <> "\n" <> indent msg
-    informError p (ParserError msg (Just pos)) =
-        putStrLn $ "Template error: " <> p <> "\n" <> indent (show pos <> "\n" <> msg)
-    indent = unlines . map (mappend "    ") . lines
-
-    -- This resolves template 'includes'.
-    includeResolver :: FilePath -> IO (Maybe String)
-    includeResolver p = either (const Nothing) Just <$> tryIOError (readFile p)
-
-{-
-The logic for copying static files and folders. Any file or folder in the
-``confTemplate`` is considered static if:
-
-- it is a symbolic link, or
-- it does not end in ".html" or ".include".
-
-Symbolic links are not followed and are copied as is. This means that a symbolic link
-from `confTemplate/link.html` to `gitserve/index.html` will be copied, keeping the
-link intact, resulting in a symbolic link at `output/link.html` essentially
-pointing to `output/gitserve/index.html`.
--}
-copyStaticDirs :: Path Abs Dir -> [Path Abs Dir] -> IO ()
-copyStaticDirs output = mapM_ copy
-  where
-    copy :: Path Abs Dir -> IO ()
-    copy p = do
-        let isRepo = (toFilePath . dirname $ p) == "repo/"
-        isLink <- pathIsSymbolicLink . toFilePath $ p
-        when (not isRepo || isLink) $ do
-            let output' = output </> dirname p
-            let fp = FP.dropTrailingPathSeparator . toFilePath $ p
-            if isLink
-                then do
-                    target <- getSymbolicLinkTarget fp
-                    createDirectoryLink target . FP.dropTrailingPathSeparator . toFilePath $ output'
-                else copyDirRecur p output'
-
-copyStaticFiles :: Path Abs Dir -> [Path Abs File] -> IO ()
-copyStaticFiles output = mapM_ copy
-  where
-    copy :: Path Abs File -> IO ()
-    copy p = do
-        let fp = toFilePath p
-        let isTemplate = FP.takeExtension fp `elem` [".html", ".include"]
-        isLink <- pathIsSymbolicLink fp
-        when (not isTemplate || isLink) $ do
-            let output' = output </> filename p
-            if isLink
-                then do
-                    target <- getSymbolicLinkTarget fp
-                    maybeExists <- forgivingAbsence . isSymlink $ output'
-                    let exists = fromMaybe False maybeExists
-                    when exists . removeFile . toFilePath $ output'
-                    createFileLink target . toFilePath $ output'
-                else copyFile p output'

src/Repositories.hs Modified

@@ -30,7 +30,8 @@
 import qualified System.FilePath as FP
 import Text.Ginger.GVal (GVal, ToGVal, toGVal)
 
-import Templates (Env (..), Template (..), generate)
+import Env (Env (..))
+import Templates (Template (..), generate)
 import Types
 
 {-

src/Main.hs Modified

@@ -17,10 +17,9 @@
 import qualified System.Directory as D
 import System.FilePath (takeDirectory, (</>))
 
-import Config (getConfig)
+import Env (getConfig, loadEnv)
 import Index (runIndex)
 import Repositories (run)
-import Templates (loadEnv)
 
 {-
 Command line options

src/Index.hs Modified

@@ -14,7 +14,8 @@
 import Text.Ginger.Parse (SourcePos)
 import Text.Ginger.Run (Run, easyRenderM)
 
-import Templates (Env (..), Template (..))
+import Env (Env (..))
+import Templates (Template (..))
 import Types
 
 {-

src/Env.hs Added

@@ -0,0 +1,206 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Env (
+    Config (..),
+    getConfig,
+    Env (..),
+    loadEnv,
+    generate,
+) where
+
+import Control.Monad (filterM, join, when, (<=<))
+import Control.Monad.Extra (findM)
+import Data.Maybe (catMaybes, fromMaybe, isNothing)
+import Data.Text (pack)
+import qualified Data.Text as T
+import Dhall
+import Dhall.Deriving
+import Path (Abs, Dir, File, Path, dirname, filename, parseAbsDir, toFilePath, (</>))
+import Path.IO (
+    copyDirRecur,
+    copyFile,
+    doesDirExist,
+    ensureDir,
+    forgivingAbsence,
+    isSymlink,
+    listDir,
+ )
+import System.Directory (
+    canonicalizePath,
+    createDirectoryLink,
+    createFileLink,
+    getSymbolicLinkTarget,
+    makeAbsolute,
+    pathIsSymbolicLink,
+    removeFile,
+ )
+import System.Exit (die)
+import qualified System.FilePath as FP
+
+import Templates (Template (..), generate, loadTemplate)
+
+{-
+The Config data type represents the configuration options available in the config file.
+Each record of the type, without the 'conf' prefix, is an option.
+-}
+data Config = Config
+    { confRepos :: [FilePath]
+    , confScan :: Bool
+    , confTemplate :: FilePath
+    , confOutput :: FilePath
+    , confHost :: Text
+    }
+    deriving stock (Generic)
+    deriving
+        (FromDhall)
+        via Codec (Field (CamelCase <<< DropPrefix "conf")) Config
+
+getConfig :: String -> IO Config
+getConfig = input auto . pack <=< makeAbsolute
+
+{-
+The Env data type represents all of the program's state, including user configuration
+and loaded template data. This can be accessed as immutable global state at any point.
+-}
+data Env = Env
+    { envConfig :: Config
+    , envIndexTemplates :: [Template]
+    , envCommitTemplate :: Maybe Template
+    , envFileTemplate :: Maybe Template
+    , envRepoTemplates :: [Template]
+    , envOutput :: Path Abs Dir
+    , envRepos :: [Path Abs Dir]
+    , envHost :: T.Text
+    , envQuiet :: Bool
+    , envForce :: Bool
+    }
+
+{-
+This creates the runtime environment, collecting the config and loading template data
+from the template directory.
+-}
+loadEnv :: Bool -> Bool -> Config -> IO Env
+loadEnv quiet force config = do
+    -- First ensure that the output directory exists
+    output <- parseAbsDir <=< canonicalizePath . confOutput $ config
+    ensureDir output
+
+    -- Parse repos for env
+    repos <-
+        if confScan config
+            then do
+                ps <- fmap concat . mapM (fmap fst . ls) . confRepos $ config
+                return . filter ((/=) ".git" . toFilePath . dirname) $ ps
+            else mapM (parseAbsDir <=< canonicalizePath) . confRepos $ config
+
+    -- Find template files, copying the static files as is
+    (dirs, files) <- ls . confTemplate $ config
+    (_, filesRepo) <- ls $ confTemplate config FP.</> "repo"
+    copyStaticDirs output dirs
+    copyStaticFiles output files
+
+    -- Load files from template directory
+    indexT <- collectTemplates files
+    commitT <- findTemplate "commit.html" filesRepo
+    fileT <- findTemplate "file.html" filesRepo
+    repoT <-
+        collectTemplates
+            . filter (flip notElem ["commit.html", "file.html"] . toFilePath . filename)
+            $ filesRepo
+
+    -- Exit early if we didn't find any templates
+    when
+        ( null indexT
+            && isNothing commitT
+            && isNothing fileT
+            && null repoT
+        )
+        $ die "No templates were found."
+
+    -- App environment
+    return
+        Env
+            { envConfig = config
+            , envIndexTemplates = indexT
+            , envCommitTemplate = commitT
+            , envFileTemplate = fileT
+            , envRepoTemplates = repoT
+            , envOutput = output
+            , envRepos = repos
+            , envHost = confHost config
+            , envQuiet = quiet
+            , envForce = force
+            }
+  where
+    ls :: FilePath -> IO ([Path Abs Dir], [Path Abs File])
+    ls dir = do
+        canon <- parseAbsDir =<< canonicalizePath dir
+        exists <- doesDirExist canon
+        if exists
+            then listDir canon
+            else return ([], [])
+
+    collectTemplates :: [Path Abs File] -> IO [Template]
+    collectTemplates = fmap catMaybes . mapM loadTemplate <=< filterM isMatch
+      where
+        isMatch p = do
+            ((FP.takeExtension . toFilePath $ p) == ".html" &&)
+                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+
+    findTemplate :: FilePath -> [Path Abs File] -> IO (Maybe Template)
+    findTemplate name = fmap join . mapM loadTemplate <=< findM isMatch
+      where
+        isMatch p =
+            ((toFilePath . filename $ p) == name &&)
+                <$> (fmap not . pathIsSymbolicLink . toFilePath $ p)
+
+{-
+The logic for copying static files and folders. Any file or folder in the
+``confTemplate`` is considered static if:
+
+- it is a symbolic link, or
+- it does not end in ".html" or ".include".
+
+Symbolic links are not followed and are copied as is. This means that a symbolic link
+from `confTemplate/link.html` to `gitserve/index.html` will be copied, keeping the
+link intact, resulting in a symbolic link at `output/link.html` essentially
+pointing to `output/gitserve/index.html`.
+-}
+copyStaticDirs :: Path Abs Dir -> [Path Abs Dir] -> IO ()
+copyStaticDirs output = mapM_ copy
+  where
+    copy :: Path Abs Dir -> IO ()
+    copy p = do
+        let isRepo = (toFilePath . dirname $ p) == "repo/"
+        isLink <- pathIsSymbolicLink . toFilePath $ p
+        when (not isRepo || isLink) $ do
+            let output' = output </> dirname p
+            let fp = FP.dropTrailingPathSeparator . toFilePath $ p
+            if isLink
+                then do
+                    target <- getSymbolicLinkTarget fp
+                    createDirectoryLink target . FP.dropTrailingPathSeparator . toFilePath $ output'
+                else copyDirRecur p output'
+
+copyStaticFiles :: Path Abs Dir -> [Path Abs File] -> IO ()
+copyStaticFiles output = mapM_ copy
+  where
+    copy :: Path Abs File -> IO ()
+    copy p = do
+        let fp = toFilePath p
+        let isTemplate = FP.takeExtension fp `elem` [".html", ".include"]
+        isLink <- pathIsSymbolicLink fp
+        when (not isTemplate || isLink) $ do
+            let output' = output </> filename p
+            if isLink
+                then do
+                    target <- getSymbolicLinkTarget fp
+                    maybeExists <- forgivingAbsence . isSymlink $ output'
+                    let exists = fromMaybe False maybeExists
+                    when exists . removeFile . toFilePath $ output'
+                    createFileLink target . toFilePath $ output'
+                else copyFile p output'

src/Config.hs Deleted

@@ -1,31 +0,0 @@
--- Required by Dhall
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE TypeOperators #-}
-
-module Config (
-    Config (..),
-    getConfig,
-) where
-
-import Control.Monad ((<=<))
-import Data.Text (pack)
-import Dhall
-import Dhall.Deriving
-import System.Directory (makeAbsolute)
-
-data Config = Config
-    { confRepos :: [FilePath]
-    , confScan :: Bool
-    , confTemplate :: FilePath
-    , confOutput :: FilePath
-    , confHost :: Text
-    }
-    deriving stock (Generic)
-    deriving
-        (FromDhall)
-        via Codec (Field (CamelCase <<< DropPrefix "conf")) Config
-
-getConfig :: String -> IO Config
-getConfig = input auto . pack <=< makeAbsolute

gitserve.cabal Modified

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