{-|
Functions for creating project initialization applications
-}

{-# LANGUAGE OverloadedStrings #-}
module ProjectForge.Actions (
    createProjectTemplateAction
  , defaultTemplateActionOpts
) where

import           Blammo.Logging.Simple
import           Control.Monad.IO.Class
import           Data.Aeson
import           Data.Text.Lazy         as TL
import qualified Data.Text.Lazy.IO      as TL
import           ProjectForge.Get
import           ProjectForge.Render
import           System.Directory
import           System.FilePath

{-|
Options for compiling, rendering and writing a a @'ProjectTemplate'@.
-}
newtype TemplateActionOpts = MkTemplateActionOpts {
    -- | The @'RenderTemplateOpts'@ for the action
    TemplateActionOpts -> RenderTemplateOpts
renderOpts :: RenderTemplateOpts
  }

-- | Default options
defaultTemplateActionOpts :: TemplateActionOpts
defaultTemplateActionOpts :: TemplateActionOpts
defaultTemplateActionOpts = MkTemplateActionOpts { renderOpts :: RenderTemplateOpts
renderOpts = RenderTemplateOpts
defaultRenderTemplateOpts}

{-|
Create an @IO@ action that compiles, renders, and writes a @'ProjectTemplate'@.
-}
createProjectTemplateAction :: (MonadLogger m, MonadIO m, ToJSON a) =>
     TemplateActionOpts
  -> FilePath -- ^ name of directory containing project template
  -> a -- ^ type which when converted via @'Data.Aeson.toJSON'@ contains values
      --    to interpolate into the @'ProjectTemplate'@.
  -> m ()
createProjectTemplateAction :: forall (m :: * -> *) a.
(MonadLogger m, MonadIO m, ToJSON a) =>
TemplateActionOpts -> FilePath -> a -> m ()
createProjectTemplateAction TemplateActionOpts
opts FilePath
d a
settings = do
  let template :: m ProjectTemplate
template = forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
FilePath -> m ProjectTemplate
getProjectTemplateFromDir FilePath
d
      values :: Value
values = forall a. ToJSON a => a -> Value
toJSON a
settings

  [(FilePath, Text)]
results <- (\ProjectTemplate
x -> forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
RenderTemplateOpts
-> ProjectTemplate -> Value -> m [(FilePath, Text)]
renderProjectTemplate (TemplateActionOpts -> RenderTemplateOpts
renderOpts TemplateActionOpts
opts) ProjectTemplate
x Value
values) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m ProjectTemplate
template

  forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
[(FilePath, Text)] -> m ()
writeTemplateResult [(FilePath, Text)]
results

{-
Utility for writing the results for @'renderProjectTemplate'@ to files.
-}
writeTemplateResult :: (MonadLogger m, MonadIO m) => [(FilePath, TL.Text)] -> m ()
writeTemplateResult :: forall (m :: * -> *).
(MonadLogger m, MonadIO m) =>
[(FilePath, Text)] -> m ()
writeTemplateResult =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(FilePath
fn, Text
cnts) -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
fn)

      forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Writing template result to file" Text -> [SeriesElem] -> Message
:# [ Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
fn ]
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
TL.writeFile FilePath
fn Text
cnts
    )