module Blagda.Template where

import           Blagda.Types
import           Control.Monad (void)
import           Data.Aeson
import           Data.Text (Text)
import qualified Data.Text as T
import           Development.Shake
import           Development.Shake.FilePath
import           Text.Mustache


writeTemplate :: ToJSON a => FilePath -> [Post Text a] -> Action ()
writeTemplate :: FilePath -> [Post Text a] -> Action ()
writeTemplate FilePath
path [Post Text a]
posts = do
  Template
template <- (Either ParseError Template -> Template)
-> Action (Either ParseError Template) -> Action Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParseError -> Template)
-> (Template -> Template) -> Either ParseError Template -> Template
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Template
forall a. HasCallStack => FilePath -> a
error (FilePath -> Template)
-> (ParseError -> FilePath) -> ParseError -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> FilePath
forall a. Show a => a -> FilePath
show) Template -> Template
forall a. a -> a
id) (Action (Either ParseError Template) -> Action Template)
-> Action (Either ParseError Template) -> Action Template
forall a b. (a -> b) -> a -> b
$ IO (Either ParseError Template)
-> Action (Either ParseError Template)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseError Template)
 -> Action (Either ParseError Template))
-> IO (Either ParseError Template)
-> Action (Either ParseError Template)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile [FilePath
"support/templates"] FilePath
path
  Action [()] -> Action ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Action [()] -> Action ()) -> Action [()] -> Action ()
forall a b. (a -> b) -> a -> b
$ [Post Text a] -> (Post Text a -> Action ()) -> Action [()]
forall a b. [a] -> (a -> Action b) -> Action [b]
forP [Post Text a]
posts ((Post Text a -> Action ()) -> Action [()])
-> (Post Text a -> Action ()) -> Action [()]
forall a b. (a -> b) -> a -> b
$ \Post Text a
post ->
    FilePath -> FilePath -> Action ()
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
writeFile' (FilePath
"_build/html1" FilePath -> FilePath -> FilePath
</> Post Text a -> FilePath
forall contents meta. Post contents meta -> FilePath
p_path Post Text a
post)
      (FilePath -> Action ()) -> FilePath -> Action ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack
      (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Template -> Value -> Text
forall k. ToMustache k => Template -> k -> Text
substitute Template
template
      (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ Post Text a -> Value
forall a. ToJSON a => a -> Value
toJSON Post Text a
post