{-# 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

-- | Build a site generator from a set of rules embedded in a 'SiteM'.
-- Use this in your @main@ function.
--
-- > main :: IO ()
-- > main = site $ do
-- >   posts <- resourceLoader markdownReader ["posts/*.md"]
-- >   writeTemplate "templates/post.html" posts
site :: SiteM () -> IO ()
site :: SiteM () -> IO ()
site = Value -> SiteM () -> IO ()
siteWithGlobals (Object -> Value
MT.Object Object
forall a. Monoid a => a
mempty)

-- | Like 'site', but allows you to pass an 'MT.Value' Object which consists
-- of an environment which is available inside your templates.
--
-- This is useful for globally providing utility functions for use in your templates.
--
-- > import qualified Text.Mustache as MT
-- > import qualified Text.Mustache.Types as MT
-- > utilityFuncs :: MT.Value
-- > utilityFuncs = MT.object
-- >   ["truncate" MT.~> MT.overText (T.take 30)
-- >   ]
-- >
-- > main :: IO ()
-- > main = siteWithGlobals utilityFuncs $ do
-- >  -- your site ...
--
-- > <!-- in your template -->
-- > {{#truncate}}
-- >   Anything inside this block will be truncated to 30 chars.
-- >   {{vars}} are interpolated before applying the function.
-- > {{/truncate}}
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)

-- | Argument info for option parsing.
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")

-- | Settings parser
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
                      ]

-- | Make given source and output dirs relative.
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
..}

-- | Remove output directory if it exists and set up for next write.
-- This is called by 'site' automatically.
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