{-# language RecordWildCards #-}
{-# language OverloadedStrings #-}
module SitePipe.Pipes
( site
, siteWithGlobals
) where
import Control.Monad.Catch as Catch
import System.Directory
import Control.Monad.Reader
import Data.Foldable
import Control.Monad.Writer
import Options.Applicative
import qualified Text.Mustache.Types as MT
import qualified Data.HashMap.Strict as HM
import SitePipe.Types
site :: SiteM () -> IO ()
site :: SiteM () -> IO ()
site = Value -> SiteM () -> IO ()
siteWithGlobals (Object -> Value
MT.Object Object
forall a. Monoid a => a
mempty)
siteWithGlobals :: MT.Value -> SiteM () -> IO ()
siteWithGlobals :: Value -> SiteM () -> IO ()
siteWithGlobals Value
globals SiteM ()
spec = do
Settings
settings <- ParserInfo Settings -> IO Settings
forall a. ParserInfo a -> IO a
execParser ParserInfo Settings
settingsInfo IO Settings -> (Settings -> IO Settings) -> IO Settings
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Settings -> IO Settings
adjSettings
FilePath -> IO ()
clean (Settings -> FilePath
outputDir Settings
settings)
(Either SitePipeError ()
result, [FilePath]
warnings) <- WriterT [FilePath] IO (Either SitePipeError ())
-> IO (Either SitePipeError (), [FilePath])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (ReaderT Settings (WriterT [FilePath] IO) (Either SitePipeError ())
-> Settings -> WriterT [FilePath] IO (Either SitePipeError ())
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SiteM ()
-> ReaderT
Settings (WriterT [FilePath] IO) (Either SitePipeError ())
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
Catch.try SiteM ()
spec) Settings
settings{globalContext :: Value
globalContext=Value
globals})
case Either SitePipeError ()
result of
Left SitePipeError
err -> SitePipeError -> IO ()
forall a. Show a => a -> IO ()
print (SitePipeError
err :: SitePipeError)
Right ()
_ -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
warnings) ((FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
putStrLn [FilePath]
warnings)
settingsInfo :: ParserInfo Settings
settingsInfo :: ParserInfo Settings
settingsInfo = Parser Settings -> InfoMod Settings -> ParserInfo Settings
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Settings
settingsP Parser Settings -> Parser (Settings -> Settings) -> Parser Settings
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Settings -> Settings)
forall a. Parser (a -> a)
helper)
( InfoMod Settings
forall a. InfoMod a
fullDesc InfoMod Settings -> InfoMod Settings -> InfoMod Settings
forall a. Semigroup a => a -> a -> a
<>
FilePath -> InfoMod Settings
forall a. FilePath -> InfoMod a
progDesc FilePath
"Static site generator" InfoMod Settings -> InfoMod Settings -> InfoMod Settings
forall a. Semigroup a => a -> a -> a
<>
FilePath -> InfoMod Settings
forall a. FilePath -> InfoMod a
header FilePath
"SitePipe - simple static site generator")
settingsP :: Parser Settings
settingsP :: Parser Settings
settingsP = FilePath -> FilePath -> Value -> Settings
Settings (FilePath -> FilePath -> Value -> Settings)
-> Parser FilePath -> Parser (FilePath -> Value -> Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption Mod OptionFields FilePath
srcD Parser (FilePath -> Value -> Settings)
-> Parser FilePath -> Parser (Value -> Settings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption Mod OptionFields FilePath
outputD Parser (Value -> Settings) -> Parser Value -> Parser Settings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> Value
MT.Object Object
forall k v. HashMap k v
HM.empty)
where
srcD :: Mod OptionFields FilePath
srcD = [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The directory where site source is stored"
, FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SOURCE_DIR"
, Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
, FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"./site"
, Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
]
outputD :: Mod OptionFields FilePath
outputD = [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory where site will be rendered"
, FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"OUTPUT_DIR"
, Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
, FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"./dist"
, Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
]
adjSettings :: Settings -> IO Settings
adjSettings :: Settings -> IO Settings
adjSettings Settings{FilePath
Value
srcDir :: Settings -> FilePath
globalContext :: Value
outputDir :: FilePath
srcDir :: FilePath
globalContext :: Settings -> Value
outputDir :: Settings -> FilePath
..} = do
FilePath
outD <- FilePath -> IO FilePath
makeAbsolute FilePath
outputDir
FilePath
srcD <- FilePath -> IO FilePath
makeAbsolute FilePath
srcDir
Settings -> IO Settings
forall (m :: * -> *) a. Monad m => a -> m a
return Settings :: FilePath -> FilePath -> Value -> Settings
Settings{outputDir :: FilePath
outputDir=FilePath
outD, srcDir :: FilePath
srcDir=FilePath
srcD, Value
globalContext :: Value
globalContext :: Value
..}
clean :: FilePath -> IO ()
clean :: FilePath -> IO ()
clean FilePath
outD = do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Purging " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
outD
Bool
exists <- FilePath -> IO Bool
doesDirectoryExist FilePath
outD
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (FilePath -> IO ()
removeDirectoryRecursive FilePath
outD)
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
outD