gitja - src/Main.hs

-rw-r--r-- src/Main.hs
      1 {-# LANGUAGE MultiWayIf #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE TemplateHaskell #-}
      4 
      5 module Main (
      6     main,
      7 ) where
      8 
      9 import Paths_gitja (version)
     10 
     11 import Control.Monad (when)
     12 import qualified Data.ByteString as B
     13 import qualified Data.ByteString.UTF8 as B
     14 import Data.FileEmbed (embedDir, embedFile)
     15 import Data.Version (showVersion)
     16 import qualified Options.Applicative as O
     17 import qualified System.Directory as D
     18 import System.FilePath (takeDirectory, (</>))
     19 
     20 import Env (getConfig, loadEnv)
     21 import Index (runIndex)
     22 import Repositories (run)
     23 
     24 {-
     25 Command line options
     26 -}
     27 data Options = Options
     28     { optConfig :: FilePath
     29     , optQuiet :: Bool
     30     , optForce :: Bool
     31     , optTemplate :: Bool
     32     , optVersion :: Bool
     33     }
     34 
     35 opts :: O.Parser Options
     36 opts =
     37     Options
     38         <$> O.strOption
     39             ( O.long "config"
     40                 <> O.short 'c'
     41                 <> O.metavar "CONFIG"
     42                 <> O.value "./config.dhall"
     43                 <> O.help "Configuration file to use (Default: ./config.dhall)."
     44             )
     45         <*> O.switch
     46             ( O.long "quiet"
     47                 <> O.short 'q'
     48                 <> O.help "Suppress non-error output."
     49             )
     50         <*> O.switch
     51             ( O.long "force"
     52                 <> O.short 'f'
     53                 <> O.help "Force regeneration of all files."
     54             )
     55         <*> O.switch
     56             ( O.long "template"
     57                 <> O.short 't'
     58                 <> O.help "Create a template and config in the current folder."
     59             )
     60         <*> O.switch
     61             ( O.long "version"
     62                 <> O.short 'v'
     63                 <> O.help "Print gitja's version."
     64             )
     65 
     66 parser :: IO Options
     67 parser =
     68     O.execParser $
     69         O.info
     70             (opts O.<**> O.helper)
     71             ( O.progDesc . B.toString $ $(embedFile "description")
     72             )
     73 
     74 {-
     75 Main logic
     76 -}
     77 main :: IO ()
     78 main = do
     79     options <- parser
     80     if
     81             | optVersion options ->
     82                 putStrLn $ "Your gitja version is: " <> showVersion version
     83             | optTemplate options ->
     84                 makeTemplate
     85             | otherwise -> do
     86                 conf <- getConfig (optConfig options)
     87                 env <- loadEnv (optQuiet options) (optForce options) conf
     88                 runIndex env =<< run env
     89 
     90 {-
     91 Put a base template and plain config into the current directory.
     92 -}
     93 makeTemplate :: IO ()
     94 makeTemplate = do
     95     tExists <- D.doesPathExist "./template"
     96     cExists <- D.doesPathExist "./config.dhall"
     97     if
     98             | tExists -> putStrLn "Failed - ./template already exists."
     99             | cExists -> putStrLn "Failed - ./config.dhall already exists."
    100             | otherwise -> do
    101                 mapM_ (uncurry place) base
    102                 B.writeFile "./config.dhall" config
    103                 putStrLn "A base template as been put at ./template."
    104                 putStrLn "A plain config has been put at ./config.dhall"
    105                 putStrLn "Add a local git repository to 'repos' in the config"
    106                 putStrLn "and run gitja to generate HTML in ./output."
    107                 oExists <- D.doesPathExist "./output"
    108                 when oExists . putStrLn $
    109                     "WARNING: ./output ALREADY EXISTS AND WILL BE OVERWRITTEN\n"
    110                         <> "UNLESS YOU MOVE/RENAME IT OR CHANGE GITSERVE'S output."
    111   where
    112     base :: [(FilePath, B.ByteString)]
    113     base = $(embedDir "templates/base")
    114 
    115     config :: B.ByteString
    116     config = $(embedFile "src/config.dhall")
    117 
    118     place :: FilePath -> B.ByteString -> IO ()
    119     place path bytes = do
    120         let path' = "template" </> path
    121         D.createDirectoryIfMissing True . takeDirectory $ path'
    122         B.writeFile path' bytes
    123