src/Types.hs Modified

@@ -1,23 +1,26 @@
-{-# Language DerivingStrategies #-}
-{-# Language LambdaCase #-}
-{-# Language OverloadedStrings #-}
-{-# Language FlexibleInstances #-}  -- Needed for `instance ToGVal`
-{-# Language MultiParamTypeClasses #-}  -- Needed for `instance ToGVal`
-{-# Language InstanceSigs #-}  -- Needed for toGVal type signature
+{-# LANGUAGE DerivingStrategies #-}
+-- Needed for `instance ToGVal`
+{-# LANGUAGE FlexibleInstances #-}
+-- Needed for toGVal type signature
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+-- Needed for `instance ToGVal`
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Types where
 
 import Data.ByteString.UTF8 (toString)
 import Data.Default (def)
 import Data.Tagged (untag)
-import Data.Text (pack, Text, strip)
+import Data.Text (Text, pack, strip)
+import qualified Data.Text as T
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
 import Git
 import Git.Libgit2 (LgRepo)
-import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml, asLookup, asList, asBoolean)
+import Text.Ginger.GVal (GVal, ToGVal, asBoolean, asHtml, asList, asLookup, asText, toGVal)
 import Text.Ginger.Html (html)
-import qualified Data.Text as T
 
 {-
 GVal implementation for `Git.Commit r`, allowing commits to be rendered in Ginger
@@ -25,11 +28,12 @@
 -}
 instance ToGVal m (Commit LgRepo) where
     toGVal :: Commit LgRepo -> GVal m
-    toGVal commit = def
-        { asHtml = html . pack . show . commitLog $ commit
-        , asText = pack . show . commitLog $ commit
-        , asLookup = Just . commitAsLookup $ commit
-        }
+    toGVal commit =
+        def
+            { asHtml = html . pack . show . commitLog $ commit
+            , asText = pack . show . commitLog $ commit
+            , asLookup = Just . commitAsLookup $ commit
+            }
 
 commitAsLookup :: Commit LgRepo -> Text -> Maybe (GVal m)
 commitAsLookup commit = \case
@@ -59,7 +63,7 @@
 data TreeFileContents = FileContents Text | FolderContents [TreeFilePath]
 
 data TreeEntryMode = ModeDirectory | ModePlain | ModeExecutable | ModeSymlink | ModeSubmodule
-    deriving stock Show
+    deriving stock (Show)
 
 showMode :: TreeEntryMode -> String
 showMode = drop 4 . show
@@ -75,18 +79,18 @@
 blobkindToMode SymlinkBlob = ModeSymlink
 
 modeToOctal :: TreeEntryMode -> String
-modeToOctal ModeDirectory  = "40000"
-modeToOctal ModePlain      = "00644"
+modeToOctal ModeDirectory = "40000"
+modeToOctal ModePlain = "00644"
 modeToOctal ModeExecutable = "00755"
-modeToOctal ModeSymlink    = "20000"
-modeToOctal ModeSubmodule  = "60000"
+modeToOctal ModeSymlink = "20000"
+modeToOctal ModeSubmodule = "60000"
 
 modeToSymbolic :: TreeEntryMode -> String
-modeToSymbolic ModeDirectory  = "drwxr-xr-x"
-modeToSymbolic ModePlain      = "-rw-r--r--"
+modeToSymbolic ModeDirectory = "drwxr-xr-x"
+modeToSymbolic ModePlain = "-rw-r--r--"
 modeToSymbolic ModeExecutable = "-rwxr-xr-x"
-modeToSymbolic ModeSymlink    = "l---------"
-modeToSymbolic ModeSubmodule  = "git-module"
+modeToSymbolic ModeSymlink = "l---------"
+modeToSymbolic ModeSubmodule = "git-module"
 
 {-
 GVal implementations for data definitions above, allowing commits to be rendered in
@@ -94,21 +98,23 @@
 -}
 instance ToGVal m TreeFile where
     toGVal :: TreeFile -> GVal m
-    toGVal treefile = def
-        { asHtml = html . pack . toString . treeFilePath $ treefile
-        , asText = pack . show . treeFilePath $ treefile
-        , asLookup = Just . treeAsLookup $ treefile
-        , asBoolean = True  -- Used for conditionally checking readme/license template variables.
-        }
+    toGVal treefile =
+        def
+            { asHtml = html . pack . toString . treeFilePath $ treefile
+            , asText = pack . show . treeFilePath $ treefile
+            , asLookup = Just . treeAsLookup $ treefile
+            , asBoolean = True -- Used for conditionally checking readme/license template variables.
+            }
 
 instance ToGVal m TreeFileContents where
     toGVal :: TreeFileContents -> GVal m
     toGVal (FileContents text) = toGVal text
-    toGVal (FolderContents filePaths) = def
-        { asHtml = html . pack . show $ filePaths
-        , asText = pack . show $ filePaths
-        , asList = Just . fmap toGVal $ filePaths
-        }
+    toGVal (FolderContents filePaths) =
+        def
+            { asHtml = html . pack . show $ filePaths
+            , asText = pack . show $ filePaths
+            , asList = Just . fmap toGVal $ filePaths
+            }
 
 treeAsLookup :: TreeFile -> Text -> Maybe (GVal m)
 treeAsLookup treefile = \case
@@ -130,7 +136,7 @@
 Get the name of a tree file path's HTML file.
 -}
 treePathToHref :: TreeFilePath -> Text
-treePathToHref = flip T.append ".html" . T.replace "/" "." .  decodeUtf8With lenientDecode
+treePathToHref = flip T.append ".html" . T.replace "/" "." . decodeUtf8With lenientDecode
 
 {-
 Data to store information about references: tags and branches.
@@ -142,11 +148,12 @@
 
 instance ToGVal m Ref where
     toGVal :: Ref -> GVal m
-    toGVal ref = def
-        { asHtml = html . refName $ ref
-        , asText = refName ref
-        , asLookup = Just . refAsLookup $ ref
-        }
+    toGVal ref =
+        def
+            { asHtml = html . refName $ ref
+            , asText = refName ref
+            , asLookup = Just . refAsLookup $ ref
+            }
 
 refAsLookup :: Ref -> Text -> Maybe (GVal m)
 refAsLookup ref = \case

src/Templates.hs Modified

@@ -1,4 +1,4 @@
-{-# Language LambdaCase #-}
+{-# LANGUAGE LambdaCase #-}
 
 module Templates (
     -- The Env data type and its constructors.
@@ -21,18 +21,18 @@
 
 import Control.Monad (filterM, void)
 import Data.Char (toLower)
+import qualified Data.HashMap.Strict as HashMap
 import Data.List (isSuffixOf)
 import Data.Maybe (catMaybes)
-import Data.Text (unpack, Text)
-import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text, unpack)
 import System.Directory (doesFileExist, getDirectoryContents)
 import System.FilePath ((</>))
 import System.IO.Error (tryIOError)
 import qualified Text.Ginger.AST as G
-import Text.Ginger.Parse (SourcePos, parseGingerFile, peErrorMessage)
 import Text.Ginger.GVal (GVal)
-import Text.Ginger.Html (htmlSource, Html)
-import Text.Ginger.Run (easyRenderM, Run)
+import Text.Ginger.Html (Html, htmlSource)
+import Text.Ginger.Parse (SourcePos, parseGingerFile, peErrorMessage)
+import Text.Ginger.Run (Run, easyRenderM)
 
 import Config
 
@@ -68,25 +68,27 @@
     commitT <- loadTemplate . commitTemplate $ config
     fileT <- loadTemplate . fileTemplate $ config
     -- Global environment
-    return Env { envConfig = config
-    , envTemplates = catMaybes templates
-    , envIndexTemplate = indexT
-    , envCommitTemplate = commitT
-    , envFileTemplate = fileT
-    , envForce = force
-    }
+    return
+        Env
+            { envConfig = config
+            , envTemplates = catMaybes templates
+            , envIndexTemplate = indexT
+            , envCommitTemplate = commitT
+            , envFileTemplate = fileT
+            , envForce = force
+            }
 
 {-
 This is the generator function that receives repository-specific variables and uses
 Ginger to render templates using them.
 -}
-generate
-    :: FilePath
-    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-    -> Template
-    -> IO ()
+generate ::
+    FilePath ->
+    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    Template ->
+    IO ()
 generate output context template = do
-    writeFile output ""  -- Clear contents of file if it exists
+    writeFile output "" -- Clear contents of file if it exists
     void $ easyRenderM (writeTo output) context . templateGinger $ template
 
 ----------------------------------------------------------------------------------------
@@ -97,11 +99,12 @@
 ``indexTemplate`` setting.
 -}
 loadTemplate :: FilePath -> IO (Maybe Template)
-loadTemplate path = parseGingerFile includeResolver path >>= \case
-    Right parsed -> return . Just . Template path $ parsed
-    Left err -> do
-        print . peErrorMessage $ err
-        return Nothing
+loadTemplate path =
+    parseGingerFile includeResolver path >>= \case
+        Right parsed -> return . Just . Template path $ parsed
+        Left err -> do
+            print . peErrorMessage $ err
+            return Nothing
 
 {-
 This is a Ginger `IncludeResolver` that will eventually be extended to enable caching of
@@ -127,9 +130,9 @@
 -}
 isTargeted :: Config -> FilePath -> Bool
 isTargeted config path =
-    path == indexTemplate config ||
-    path == commitTemplate config ||
-    path == fileTemplate config
+    path == indexTemplate config
+        || path == commitTemplate config
+        || path == fileTemplate config
 
 {-
 This wraps getDirectoryContents so that we get a list of fully qualified paths of the
@@ -143,7 +146,7 @@
 valid template files.
 -}
 getFiles :: Config -> IO [FilePath]
-getFiles = ((>>=) . listTemplates . templateDirectory) <*> (filterM  . isTemplate)
+getFiles = ((>>=) . listTemplates . templateDirectory) <*> (filterM . isTemplate)
 
 {-
 This function gets the output HTML data and is responsible for saving it to file.

src/Repositories.hs Modified

@@ -1,30 +1,32 @@
-{-# Language LambdaCase #-}
-{-# Language OverloadedStrings #-}
-{-# Language FlexibleInstances #-}  -- Needed for the Target class type constraints
-{-# Language FlexibleContexts #-}  -- Needed for the Target class type constraints
+-- Needed for the Target class type constraints
+{-# LANGUAGE FlexibleContexts #-}
+-- Needed for the Target class type constraints
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Repositories (
     run,
 ) where
 
-import Conduit (runConduit, (.|), sinkList)
-import Control.Monad ((<=<), when)
+import Conduit (runConduit, sinkList, (.|))
+import Control.Monad (when, (<=<))
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans.Reader (ReaderT)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Maybe (catMaybes, fromJust, mapMaybe)
 import Data.Tagged
-import Data.Text (pack, unpack, Text, isPrefixOf, stripPrefix, toLower)
+import Data.Text (Text, isPrefixOf, pack, stripPrefix, toLower, unpack)
 import Data.Text.Encoding (decodeUtf8With)
 import Data.Text.Encoding.Error (lenientDecode)
-import Data.Maybe (mapMaybe, catMaybes, fromJust)
 import Git
-import Git.Libgit2 (lgFactory, LgRepo)
+import Git.Libgit2 (LgRepo, lgFactory)
 import System.Directory (createDirectoryIfMissing, doesFileExist)
-import System.FilePath ((</>), takeFileName)
-import Text.Ginger.GVal (GVal, toGVal, ToGVal)
+import System.FilePath (takeFileName, (</>))
+import Text.Ginger.GVal (GVal, ToGVal, toGVal)
 import Text.Ginger.Html (Html)
-import Text.Ginger.Run (Run)
 import Text.Ginger.Parse (SourcePos)
-import qualified Data.HashMap.Strict as HashMap
+import Text.Ginger.Run (Run)
 
 import Config
 import Index
@@ -38,7 +40,6 @@
 run :: Env -> [Repo] -> IO ()
 run = mapM_ . processRepo
 
-
 ----------------------------------------------------------------------------------------
 -- Private -----------------------------------------------------------------------------
 
@@ -72,7 +73,7 @@
             liftIO . createDirectoryIfMissing True $ output </> "commits"
             liftIO . createDirectoryIfMissing True $ output </> "files"
             liftIO . mapM_ (genTarget output scope force $ envCommitTemplate env) $ commits
-            liftIO . mapM_ (genTarget output scope True $ envFileTemplate env) $ tree  -- TODO: detect file changes
+            liftIO . mapM_ (genTarget output scope True $ envFileTemplate env) $ tree -- TODO: detect file changes
 
 {-
 The role of the function above is to gather information about a git repository and
@@ -80,34 +81,36 @@
 Ginger templates. `package` takes these pieces of information and places it all into a
 hashmap which Ginger can use to look up variables.
 -}
-package
-    :: Env
-    -> FilePath
-    -> Text
-    -> [Commit LgRepo]
-    -> [TreeFile]
-    -> [Ref]
-    -> [Ref]
-    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-package env name description commits tree tags branches = HashMap.fromList
-    [ ("host", toGVal . host . envConfig $ env)
-    , ("name", toGVal . pack $ name)
-    , ("description", toGVal description)
-    , ("commits", toGVal . reverse $ commits)  -- Could be optimised
-    , ("tree", toGVal tree)
-    , ("tags", toGVal tags)
-    , ("branches", toGVal branches)
-    , ("readme", toGVal . findFile "readme" $ tree)
-    , ("license", toGVal . findFile "license" $ tree)
-    ]
+package ::
+    Env ->
+    FilePath ->
+    Text ->
+    [Commit LgRepo] ->
+    [TreeFile] ->
+    [Ref] ->
+    [Ref] ->
+    HashMap.HashMap Text (GVal (Run SourcePos IO Html))
+package env name description commits tree tags branches =
+    HashMap.fromList
+        [ ("host", toGVal . host . envConfig $ env)
+        , ("name", toGVal . pack $ name)
+        , ("description", toGVal description)
+        , ("commits", toGVal . reverse $ commits) -- Could be optimised
+        , ("tree", toGVal tree)
+        , ("tags", toGVal tags)
+        , ("branches", toGVal branches)
+        , ("readme", toGVal . findFile "readme" $ tree)
+        , ("license", toGVal . findFile "license" $ tree)
+        ]
 
 {-
 Collect commit information.
 -}
 getCommits :: CommitOid LgRepo -> ReaderT LgRepo IO [Commit LgRepo]
 getCommits commitID =
-    sequence . mapMaybe loadCommit <=<
-    runConduit $ sourceObjects Nothing commitID False .| sinkList
+    sequence . mapMaybe loadCommit
+        <=< runConduit
+        $ sourceObjects Nothing commitID False .| sinkList
 
 loadCommit :: ObjectOid LgRepo -> Maybe (ReaderT LgRepo IO (Commit LgRepo))
 loadCommit (CommitObjOid oid) = Just $ lookupCommit oid
@@ -139,7 +142,7 @@
 -}
 findFile :: Text -> [TreeFile] -> Maybe TreeFile
 findFile _ [] = Nothing
-findFile prefix (f:fs) = if isReadme f then Just f else findFile prefix fs
+findFile prefix (f : fs) = if isReadme f then Just f else findFile prefix fs
   where
     isReadme = isPrefixOf prefix . toLower . decodeUtf8With lenientDecode . treeFilePath
 
@@ -156,7 +159,6 @@
     maybeCommits <- mapM refObjToCommit objs
     let names'' = map (fromJust . stripPrefix ref) . catMaybes . zipWith dropName maybeCommits $ names'
     return . zipWith Ref names'' . catMaybes $ maybeCommits
-
   where
     refObjToCommit :: Object r m -> ReaderT LgRepo IO (Maybe (Commit r))
     refObjToCommit (CommitObj obj) = return . Just $ obj
@@ -166,11 +168,11 @@
     dropName (Just _) name = Just name
     dropName Nothing _ = Nothing
 
-genRepo
-    :: FilePath
-    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-    -> Template
-    -> IO ()
+genRepo ::
+    FilePath ->
+    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    Template ->
+    IO ()
 genRepo output scope template = generate output' scope template
   where
     output' = (</>) output . takeFileName . templatePath $ template
@@ -197,14 +199,14 @@
     identify = unpack . treePathToHref . treeFilePath
     category = const "file"
 
-genTarget
-    :: Target a
-    => FilePath
-    -> HashMap.HashMap Text (GVal (Run SourcePos IO Html))
-    -> Bool
-    -> Maybe Template
-    -> a
-    -> IO ()
+genTarget ::
+    Target a =>
+    FilePath ->
+    HashMap.HashMap Text (GVal (Run SourcePos IO Html)) ->
+    Bool ->
+    Maybe Template ->
+    a ->
+    IO ()
 genTarget _ _ _ Nothing _ = return ()
 genTarget output scope force (Just template) target = do
     let output' = output </> category target </> identify target

src/Main.hs Modified

@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main (
-    main
+    main,
 ) where
 
 import Paths_gitserve (version)
@@ -12,8 +12,8 @@
 
 import Config (getConfig)
 import Index (runIndex)
-import Templates (loadTemplates)
 import Repositories (run)
+import Templates (loadTemplates)
 
 {-
 Command line options
@@ -25,29 +25,33 @@
     }
 
 opts :: O.Parser Options
-opts = Options
-    <$> O.strOption (
-        O.long "config" <>
-        O.short 'c' <>
-        O.metavar "CONFIG" <>
-        O.value "./config.dhall" <>
-        O.help "Configuration file to use (Default: ./config.dhall)"
-        )
-    <*> O.switch (
-        O.long "force" <>
-        O.short 'f' <>
-        O.help "Force regeneration of all files"
-        )
-    <*> O.switch (
-        O.long "version" <>
-        O.short 'v' <>
-        O.help "Print the gitserve's version"
-        )
+opts =
+    Options
+        <$> O.strOption
+            ( O.long "config"
+                <> O.short 'c'
+                <> O.metavar "CONFIG"
+                <> O.value "./config.dhall"
+                <> O.help "Configuration file to use (Default: ./config.dhall)"
+            )
+        <*> O.switch
+            ( O.long "force"
+                <> O.short 'f'
+                <> O.help "Force regeneration of all files"
+            )
+        <*> O.switch
+            ( O.long "version"
+                <> O.short 'v'
+                <> O.help "Print the gitserve's version"
+            )
 
 parser :: IO Options
-parser = O.execParser $ O.info (opts O.<**> O.helper)
-    ( O.progDesc "🐙 Templated web page generator for your git repositories"
-    )
+parser =
+    O.execParser $
+        O.info
+            (opts O.<**> O.helper)
+            ( O.progDesc "🐙 Templated web page generator for your git repositories"
+            )
 
 {-
 Main logic
@@ -56,8 +60,7 @@
 main = do
     options <- parser
     if printVersion options
-        then
-            putStrLn $ "Your gitserve version is: " <> showVersion version
+        then putStrLn $ "Your gitserve version is: " <> showVersion version
         else do
             conf <- getConfig (config options)
             env <- loadTemplates (force options) conf

src/Index.hs Modified

@@ -1,8 +1,11 @@
-{-# Language LambdaCase #-}
-{-# Language OverloadedStrings #-}
-{-# Language FlexibleInstances #-}  -- Needed for `instance ToGVal`
-{-# Language MultiParamTypeClasses #-}  -- Needed for `instance ToGVal`
-{-# Language InstanceSigs #-}  -- Needed for toGVal type signature
+-- Needed for `instance ToGVal`
+{-# LANGUAGE FlexibleInstances #-}
+-- Needed for toGVal type signature
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
+-- Needed for `instance ToGVal`
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Index (
     runIndex,
@@ -14,15 +17,15 @@
 
 import Data.Default (def)
 import Data.Either (fromRight)
-import Data.Text (pack, Text)
+import qualified Data.HashMap.Strict as HashMap
+import Data.Text (Text, pack)
 import System.Directory (createDirectoryIfMissing)
-import System.FilePath ((</>), takeFileName)
+import System.FilePath (takeFileName, (</>))
 import System.IO.Error (tryIOError)
-import Text.Ginger.GVal (GVal, toGVal, ToGVal, asText, asHtml, asLookup)
+import Text.Ginger.GVal (GVal, ToGVal, asHtml, asLookup, asText, toGVal)
 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 Templates
@@ -58,11 +61,12 @@
 
 instance ToGVal m Repo where
     toGVal :: Repo -> GVal m
-    toGVal repo = def
-        { asHtml = html . pack . show . takeFileName . repoPath $ repo
-        , asText = pack . show . takeFileName . repoPath $ repo
-        , asLookup = Just . repoAsLookup $ repo
-        }
+    toGVal repo =
+        def
+            { asHtml = html . pack . show . takeFileName . repoPath $ repo
+            , asText = pack . show . takeFileName . repoPath $ repo
+            , asLookup = Just . repoAsLookup $ repo
+            }
 
 repoAsLookup :: Repo -> Text -> Maybe (GVal m)
 repoAsLookup repo = \case
@@ -70,21 +74,21 @@
     "description" -> Just . toGVal . repoDescription $ repo
     _ -> Nothing
 
-
 ----------------------------------------------------------------------------------------
 -- 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)
-    ]
+packageIndex ::
+    Config ->
+    [Repo] ->
+    HashMap.HashMap Text (GVal (Run SourcePos IO Html))
+packageIndex config repos =
+    HashMap.fromList
+        [ ("host", toGVal $ host config)
+        , ("repositories", toGVal repos)
+        ]
 
 {-
 Get paths along with their descriptions.

src/Config.hs Modified

@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveGeneric #-}  -- Required by Dhall
+-- Required by Dhall
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 
 module Config (
@@ -10,7 +11,7 @@
     fileTemplate,
     getConfig,
     outputDirectory,
-    host
+    host,
 ) where
 
 import Dhall