{-# LANGUAGE QuasiQuotes #-}

module Hinit.Template where

import Control.Effect.Lift
import Control.Effect.Throw
import Control.Monad
import Control.Monad.IO.Class
import Data.Foldable
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import Data.String.Interpolate
import Data.Text (Text, pack, unpack)
import qualified Data.Text.IO as T
import GHC.Generics
import Hinit.Errors
import Hinit.Template.Config
import Hinit.Types
import Hinit.Utils
import Path
import Path.IO
import Paths_hinit
import Prettyprinter
import System.FilePath.Glob
import Text.Mustache hiding (Template)
import Text.Mustache.Types (Value)
import Toml (decode)
import Toml.Codec.Error (TomlDecodeError)

data Template
  = Local
      { Template -> Path Abs Dir
path :: Path Abs Dir,
        Template -> Text
name :: Text,
        Template -> TemplateConfig
templateConfig :: TemplateConfig
      }
  | Broken
      { path :: Path Abs Dir,
        name :: Text,
        Template -> [TomlDecodeError]
errors :: [TomlDecodeError]
      }
  deriving (Int -> Template -> ShowS
[Template] -> ShowS
Template -> String
(Int -> Template -> ShowS)
-> (Template -> String) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Template] -> ShowS
$cshowList :: [Template] -> ShowS
show :: Template -> String
$cshow :: Template -> String
showsPrec :: Int -> Template -> ShowS
$cshowsPrec :: Int -> Template -> ShowS
Show, Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c== :: Template -> Template -> Bool
Eq, (forall x. Template -> Rep Template x)
-> (forall x. Rep Template x -> Template) -> Generic Template
forall x. Rep Template x -> Template
forall x. Template -> Rep Template x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Template x -> Template
$cfrom :: forall x. Template -> Rep Template x
Generic)

fromContext :: Context -> Value
fromContext :: Context -> Value
fromContext = [Pair] -> Value
object ([Pair] -> Value) -> (Context -> [Pair]) -> Context -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Val) -> Pair) -> [(Text, Val)] -> [Pair]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Val -> Pair) -> (Text, Val) -> Pair
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Val -> Pair
forall ω. ToMustache ω => Text -> ω -> Pair
(~>)) ([(Text, Val)] -> [Pair])
-> (Context -> [(Text, Val)]) -> Context -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> [(Text, Val)]
forall k a. Map k a -> [(k, a)]
M.toList

underCurrentDir :: Path Rel a -> Bool
underCurrentDir :: Path Rel a -> Bool
underCurrentDir = (Path Rel Dir -> Path Rel Dir -> Bool
forall a. Eq a => a -> a -> Bool
== [reldir|./|]) (Path Rel Dir -> Bool)
-> (Path Rel a -> Path Rel Dir) -> Path Rel a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel a -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent

-- | Copy a file from template to the corresponding location in the target directory and apply substitution.
--   Note that this function assumes that the parent directory of the target file exists.
copyFileFromTemplate ::
  ( Has (Throw MustacheError) sig m,
    Has (Throw IllformedPath) sig m,
    Has (Lift IO) sig m,
    ToMustache ctx
  ) =>
  -- | Mustache context
  ctx ->
  -- | Base dir of the template
  Path a Dir ->
  -- | Base dir of the target
  Path b Dir ->
  -- | Source file path relative to the template base
  Path Rel File ->
  m ()
copyFileFromTemplate :: ctx -> Path a Dir -> Path b Dir -> Path Rel File -> m ()
copyFileFromTemplate ctx
ctx Path a Dir
base Path b Dir
tgtbase Path Rel File
src = do
  let srcFilename :: Path Rel File
srcFilename = Path Rel File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path Rel File
src
  let srcParentDir :: Path Rel Dir
srcParentDir = Path Rel File -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent Path Rel File
src
  case String -> Text -> Either ParseError Template
compileTemplate String
"" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel File -> String
fromRelFile Path Rel File
srcFilename) of
    Left ParseError
e -> MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Bool -> Text -> MustacheError
forall a. Path Rel a -> Bool -> Text -> MustacheError
TemplateParseError Path Rel File
src Bool
True (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
    Right Template
fileNameTmpl -> do
      let ([SubstitutionError]
errs, Text
tgtFileNameRaw) = Template -> ctx -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
checkedSubstitute Template
fileNameTmpl ctx
ctx
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([SubstitutionError] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [SubstitutionError]
errs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Bool -> [SubstitutionError] -> MustacheError
forall a.
Path Rel a -> Bool -> [SubstitutionError] -> MustacheError
RenderingError Path Rel File
src Bool
True [SubstitutionError]
errs
      let err :: IllformedPath
err = Path Rel File -> Text -> IllformedPath
forall a. Path Rel a -> Text -> IllformedPath
TemplateFile Path Rel File
src Text
tgtFileNameRaw
      case String -> Maybe (Path Rel File)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Rel File)
parseRelFile (Text -> String
unpack Text
tgtFileNameRaw) of
        Maybe (Path Rel File)
Nothing -> IllformedPath -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
        Just Path Rel File
tgtFileName
          | Bool -> Bool
not (Path Rel File -> Bool
forall a. Path Rel a -> Bool
underCurrentDir Path Rel File
tgtFileName) -> IllformedPath -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
          | Bool
otherwise -> do
            let srcFilePath :: Path a File
srcFilePath = Path a Dir
base Path a Dir -> Path Rel File -> Path a File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
src
            let tgtFilePath :: Path b File
tgtFilePath = Path b Dir
tgtbase Path b Dir -> Path Rel File -> Path b File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
srcParentDir Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
tgtFileName
            Text
srcFileContent <- IO Text -> m Text
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile (Path a File -> String
forall b t. Path b t -> String
toFilePath Path a File
srcFilePath)
            case String -> Text -> Either ParseError Template
compileTemplate (Path Rel File -> String
forall b t. Path b t -> String
toFilePath Path Rel File
src) Text
srcFileContent of
              Left ParseError
e' -> MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Bool -> Text -> MustacheError
forall a. Path Rel a -> Bool -> Text -> MustacheError
TemplateParseError Path Rel File
src Bool
False (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e')
              Right Template
fileTmpl -> do
                let ([SubstitutionError]
errs', Text
tgtFileContent) = Template -> ctx -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
checkedSubstitute Template
fileTmpl ctx
ctx
                Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([SubstitutionError] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [SubstitutionError]
errs') (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
                  MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel File -> Bool -> [SubstitutionError] -> MustacheError
forall a.
Path Rel a -> Bool -> [SubstitutionError] -> MustacheError
RenderingError Path Rel File
src Bool
False [SubstitutionError]
errs'
                IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile (Path b File -> String
forall b t. Path b t -> String
toFilePath Path b File
tgtFilePath) Text
tgtFileContent

-- | Copy a directory from template to the corresponding location in the target directory and apply substitution.
--   Note that this function assumes that the parent directory of the target directory exists.
copyDirFromTemplate ::
  ( Has (Throw MustacheError) sig m,
    Has (Throw IllformedPath) sig m,
    Has (Lift IO) sig m,
    ToMustache ctx
  ) =>
  -- | Mustache context
  ctx ->
  -- | Base dir of the template
  Path a Dir ->
  -- | Base dir of the target
  Path b Dir ->
  -- | Source dir path relative to the template base
  Path Rel Dir ->
  m ()
copyDirFromTemplate :: ctx -> Path a Dir -> Path b Dir -> Path Rel Dir -> m ()
copyDirFromTemplate ctx
ctx Path a Dir
_ Path b Dir
tgtbase Path Rel Dir
src = do
  let srcDirName :: Path Rel Dir
srcDirName = Path Rel Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Rel Dir
src
  let srcParentDir :: Path Rel Dir
srcParentDir = Path Rel Dir -> Path Rel Dir
forall b t. Path b t -> Path b Dir
parent Path Rel Dir
src
  case String -> Text -> Either ParseError Template
compileTemplate String
"" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> String
fromRelDir Path Rel Dir
srcDirName) of
    Left ParseError
e -> MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Bool -> Text -> MustacheError
forall a. Path Rel a -> Bool -> Text -> MustacheError
TemplateParseError Path Rel Dir
src Bool
True (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
    Right Template
fileNameTmpl -> do
      let ([SubstitutionError]
errs, Text
tgtFileNameRaw) = Template -> ctx -> ([SubstitutionError], Text)
forall k.
ToMustache k =>
Template -> k -> ([SubstitutionError], Text)
checkedSubstitute Template
fileNameTmpl ctx
ctx
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless ([SubstitutionError] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [SubstitutionError]
errs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        MustacheError -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (MustacheError -> m ()) -> MustacheError -> m ()
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> Bool -> [SubstitutionError] -> MustacheError
forall a.
Path Rel a -> Bool -> [SubstitutionError] -> MustacheError
RenderingError Path Rel Dir
src Bool
True [SubstitutionError]
errs
      let err :: IllformedPath
err = Path Rel Dir -> Text -> IllformedPath
forall a. Path Rel a -> Text -> IllformedPath
TemplateFile Path Rel Dir
src Text
tgtFileNameRaw
      case String -> Maybe (Path Rel Dir)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Rel Dir)
parseRelDir (Text -> String
unpack Text
tgtFileNameRaw) of
        Maybe (Path Rel Dir)
Nothing -> IllformedPath -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
        Just Path Rel Dir
tgtDirName
          | Bool -> Bool
not (Path Rel Dir -> Bool
forall a. Path Rel a -> Bool
underCurrentDir Path Rel Dir
tgtDirName) -> IllformedPath -> m ()
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError IllformedPath
err
          | Bool
otherwise -> do
            let tgtDirPath :: Path b Dir
tgtDirPath = Path b Dir
tgtbase Path b Dir -> Path Rel Dir -> Path b Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
srcParentDir Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
tgtDirName
            IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> Path b Dir -> IO ()
forall (m :: Type -> Type) b.
MonadIO m =>
Bool -> Path b Dir -> m ()
createDirIfMissing Bool
False Path b Dir
tgtDirPath

-- | Initialize a project from a template
initFromTemplate ::
  ( Has (Throw MustacheError) sig m,
    Has (Throw IllformedPath) sig m,
    Has (Lift IO) sig m,
    MonadIO m,
    ToMustache ctx
  ) =>
  -- | Ignored files
  [Pattern] ->
  -- | Mustache context
  ctx ->
  -- | Base dir of the template
  Path a Dir ->
  -- | Base dir of the target
  Path b Dir ->
  m ()
initFromTemplate :: [Pattern] -> ctx -> Path a Dir -> Path b Dir -> m ()
initFromTemplate [Pattern]
ignores ctx
ctx Path a Dir
template Path b Dir
target = do
  IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Path b Dir -> IO ()
forall (m :: Type -> Type) b. MonadIO m => Path b Dir -> m ()
ensureDir Path b Dir
target
  (Path Rel Dir
 -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel))
-> Path a Dir -> m ()
forall (m :: Type -> Type) b.
MonadIO m =>
(Path Rel Dir
 -> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel))
-> Path b Dir -> m ()
walkDirRel Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)
handler Path a Dir
template
  where
    handler :: Path Rel Dir
-> [Path Rel Dir] -> [Path Rel File] -> m (WalkAction Rel)
handler Path Rel Dir
current [Path Rel Dir]
subdirs [Path Rel File]
files = do
      (Path Rel File -> m ()) -> [Path Rel File] -> m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ctx -> Path a Dir -> Path b Dir -> Path Rel File -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       ctx a b.
(Has (Throw MustacheError) sig m, Has (Throw IllformedPath) sig m,
 Has (Lift IO) sig m, ToMustache ctx) =>
ctx -> Path a Dir -> Path b Dir -> Path Rel File -> m ()
copyFileFromTemplate ctx
ctx Path a Dir
template Path b Dir
target) [Path Rel File]
filesToCpy
      (Path Rel Dir -> m ()) -> [Path Rel Dir] -> m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ctx -> Path a Dir -> Path b Dir -> Path Rel Dir -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       ctx a b.
(Has (Throw MustacheError) sig m, Has (Throw IllformedPath) sig m,
 Has (Lift IO) sig m, ToMustache ctx) =>
ctx -> Path a Dir -> Path b Dir -> Path Rel Dir -> m ()
copyDirFromTemplate ctx
ctx Path a Dir
template Path b Dir
target) [Path Rel Dir]
dirsToCpy
      WalkAction Rel -> m (WalkAction Rel)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (WalkAction Rel -> m (WalkAction Rel))
-> WalkAction Rel -> m (WalkAction Rel)
forall a b. (a -> b) -> a -> b
$ [Path Rel Dir] -> WalkAction Rel
forall b. [Path b Dir] -> WalkAction b
WalkExclude [Path Rel Dir]
excl
      where
        subdirs' :: [Path Rel Dir]
subdirs' = (Path Rel Dir -> Path Rel Dir) -> [Path Rel Dir] -> [Path Rel Dir]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir
current Path Rel Dir -> Path Rel Dir -> Path Rel Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) [Path Rel Dir]
subdirs
        files' :: [Path Rel File]
files' = (Path Rel File -> Path Rel File)
-> [Path Rel File] -> [Path Rel File]
forall a b. (a -> b) -> [a] -> [b]
map (Path Rel Dir
current Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</>) [Path Rel File]
files
        ignored :: Path Rel a -> Bool
        ignored :: Path Rel a -> Bool
ignored Path Rel a
a = [Pattern]
ignores [Pattern] -> String -> Bool
`matches` Path Rel a -> String
forall b t. Path b t -> String
toFilePath Path Rel a
a
        excl :: [Path Rel Dir]
excl = (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter Path Rel Dir -> Bool
forall a. Path Rel a -> Bool
ignored [Path Rel Dir]
subdirs'
        dirsToCpy :: [Path Rel Dir]
dirsToCpy = (Path Rel Dir -> Bool) -> [Path Rel Dir] -> [Path Rel Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel Dir -> Bool) -> Path Rel Dir -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> Bool
forall a. Path Rel a -> Bool
ignored) [Path Rel Dir]
subdirs'
        filesToCpy :: [Path Rel File]
filesToCpy = (Path Rel File -> Bool) -> [Path Rel File] -> [Path Rel File]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Path Rel File -> Bool) -> Path Rel File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> Bool
forall a. Path Rel a -> Bool
ignored) [Path Rel File]
files'

readTemplate :: Has (Lift IO) sig m => Path Abs Dir -> m (Maybe Template)
readTemplate :: Path Abs Dir -> m (Maybe Template)
readTemplate Path Abs Dir
templatePath = do
  let templateConfigFile :: Path Abs File
templateConfigFile = Path Abs Dir
templatePath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [relfile|template.toml|]
  let name :: Text
name = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
init ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Path Rel Dir -> String
fromRelDir (Path Rel Dir -> String) -> Path Rel Dir -> String
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Rel Dir
forall b. Path b Dir -> Path Rel Dir
dirname Path Abs Dir
templatePath
  Bool
exists <- IO Bool -> m Bool
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Path Abs File -> IO Bool
forall (m :: Type -> Type) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
templateConfigFile
  if Bool
exists
    then do
      Text
f <- IO Text -> m Text
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
fromAbsFile Path Abs File
templateConfigFile
      case TomlCodec TemplateConfig
-> Text -> Either [TomlDecodeError] TemplateConfig
forall a. TomlCodec a -> Text -> Either [TomlDecodeError] a
decode TomlCodec TemplateConfig
templateConfigCodec Text
f of
        Left [TomlDecodeError]
errors -> Maybe Template -> m (Maybe Template)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Template -> m (Maybe Template))
-> Maybe Template -> m (Maybe Template)
forall a b. (a -> b) -> a -> b
$ Template -> Maybe Template
forall a. a -> Maybe a
Just Broken :: Path Abs Dir -> Text -> [TomlDecodeError] -> Template
Broken {path :: Path Abs Dir
path = Path Abs Dir
templatePath, [TomlDecodeError]
Text
errors :: [TomlDecodeError]
name :: Text
errors :: [TomlDecodeError]
name :: Text
..}
        Right TemplateConfig
templateConfig -> Maybe Template -> m (Maybe Template)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Template -> m (Maybe Template))
-> Maybe Template -> m (Maybe Template)
forall a b. (a -> b) -> a -> b
$ Template -> Maybe Template
forall a. a -> Maybe a
Just Local :: Path Abs Dir -> Text -> TemplateConfig -> Template
Local {path :: Path Abs Dir
path = Path Abs Dir
templatePath, Text
TemplateConfig
templateConfig :: TemplateConfig
name :: Text
templateConfig :: TemplateConfig
name :: Text
..}
    else Maybe Template -> m (Maybe Template)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Maybe Template
forall a. Maybe a
Nothing

getTemplateDirs :: Has (Lift IO) sig m => m [Path Abs Dir]
getTemplateDirs :: m [Path Abs Dir]
getTemplateDirs = do
  String
dataDirRaw <- IO String -> m String
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO String
getDataDir
  Path Abs Dir
dataDir <- IO (Path Abs Dir) -> m (Path Abs Dir)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (Path Abs Dir) -> m (Path Abs Dir))
-> IO (Path Abs Dir) -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ String -> IO (Path Abs Dir)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Abs Dir)
parseAbsDir String
dataDirRaw
  let bundledTemplateDir :: Path Abs Dir
bundledTemplateDir = Path Abs Dir
dataDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> [reldir|templates|]
  Path Abs Dir
localTemplateDir <- IO (Path Abs Dir) -> m (Path Abs Dir)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (Path Abs Dir) -> m (Path Abs Dir))
-> IO (Path Abs Dir) -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ XdgDirectory -> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall (m :: Type -> Type).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
getXdgDir XdgDirectory
XdgData (Path Rel Dir -> Maybe (Path Rel Dir)
forall a. a -> Maybe a
Just [reldir|hi|])
  let dirs :: [Path Abs Dir]
dirs = [Path Abs Dir
bundledTemplateDir, Path Abs Dir
localTemplateDir]
  (Path Abs Dir -> m ()) -> [Path Abs Dir] -> m ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO () -> m ()) -> (Path Abs Dir -> IO ()) -> Path Abs Dir -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> IO ()
forall (m :: Type -> Type) b. MonadIO m => Path b Dir -> m ()
ensureDir) [Path Abs Dir]
dirs
  [Path Abs Dir] -> m [Path Abs Dir]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Path Abs Dir]
dirs

getTemplate ::
  ( Has (Lift IO) sig m,
    Has (Throw IllformedPath) sig m
  ) =>
  Text ->
  m (Maybe Template)
getTemplate :: Text -> m (Maybe Template)
getTemplate Text
tmpl = do
  [Path Abs Dir]
templateDirs <- m [Path Abs Dir]
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has (Lift IO) sig m =>
m [Path Abs Dir]
getTemplateDirs
  case String -> Maybe (Path Rel Dir)
forall (m :: Type -> Type).
MonadThrow m =>
String -> m (Path Rel Dir)
parseRelDir (Text -> String
unpack Text
tmpl) of
    Maybe (Path Rel Dir)
Nothing -> IllformedPath -> m (Maybe Template)
forall e (sig :: (Type -> Type) -> Type -> Type)
       (m :: Type -> Type) a.
Has (Throw e) sig m =>
e -> m a
throwError (IllformedPath -> m (Maybe Template))
-> IllformedPath -> m (Maybe Template)
forall a b. (a -> b) -> a -> b
$ Text -> IllformedPath
TemplateName Text
tmpl
    Just Path Rel Dir
templateName -> do
      let templates :: [Path Abs Dir]
templates = (Path Abs Dir -> Path Abs Dir) -> [Path Abs Dir] -> [Path Abs Dir]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
templateName) [Path Abs Dir]
templateDirs
      [Maybe Template]
mTemplates <- (Path Abs Dir -> m (Maybe Template))
-> [Path Abs Dir] -> m [Maybe Template]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Abs Dir -> m (Maybe Template)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has (Lift IO) sig m =>
Path Abs Dir -> m (Maybe Template)
readTemplate [Path Abs Dir]
templates
      Maybe Template -> m (Maybe Template)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe Template -> m (Maybe Template))
-> Maybe Template -> m (Maybe Template)
forall a b. (a -> b) -> a -> b
$ First Template -> Maybe Template
forall a. First a -> Maybe a
getFirst (First Template -> Maybe Template)
-> First Template -> Maybe Template
forall a b. (a -> b) -> a -> b
$ (Maybe Template -> First Template)
-> [Maybe Template] -> First Template
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe Template -> First Template
forall a. Maybe a -> First a
First [Maybe Template]
mTemplates

getTemplates :: Has (Lift IO) sig m => m [Template]
getTemplates :: m [Template]
getTemplates = do
  [Path Abs Dir]
templateDirs <- m [Path Abs Dir]
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has (Lift IO) sig m =>
m [Path Abs Dir]
getTemplateDirs
  [([Path Abs Dir], [Path Abs File])]
contents <- (Path Abs Dir -> m ([Path Abs Dir], [Path Abs File]))
-> [Path Abs Dir] -> m [([Path Abs Dir], [Path Abs File])]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (IO ([Path Abs Dir], [Path Abs File])
-> m ([Path Abs Dir], [Path Abs File])
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO ([Path Abs Dir], [Path Abs File])
 -> m ([Path Abs Dir], [Path Abs File]))
-> (Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File]))
-> Path Abs Dir
-> m ([Path Abs Dir], [Path Abs File])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: Type -> Type) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir) [Path Abs Dir]
templateDirs
  let subdirs :: [Path Abs Dir]
subdirs = (([Path Abs Dir], [Path Abs File]) -> [Path Abs Dir])
-> [([Path Abs Dir], [Path Abs File])] -> [Path Abs Dir]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ([Path Abs Dir], [Path Abs File]) -> [Path Abs Dir]
forall a b. (a, b) -> a
fst [([Path Abs Dir], [Path Abs File])]
contents
  [Maybe Template]
mTemplates <- (Path Abs Dir -> m (Maybe Template))
-> [Path Abs Dir] -> m [Maybe Template]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Path Abs Dir -> m (Maybe Template)
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has (Lift IO) sig m =>
Path Abs Dir -> m (Maybe Template)
readTemplate [Path Abs Dir]
subdirs
  [Template] -> m [Template]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Template] -> m [Template]) -> [Template] -> m [Template]
forall a b. (a -> b) -> a -> b
$ [Maybe Template] -> [Template]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Template]
mTemplates

prettyTemplate :: Bool -> Template -> Doc a
prettyTemplate :: Bool -> Template -> Doc a
prettyTemplate Bool
verbose Template
template
  | Broken {[TomlDecodeError]
Text
Path Abs Dir
errors :: [TomlDecodeError]
name :: Text
path :: Path Abs Dir
errors :: Template -> [TomlDecodeError]
name :: Template -> Text
path :: Template -> Path Abs Dir
..} <- Template
template =
    if Bool
verbose
      then
        [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep
          [ [i|template: #{name}|],
            [i|path: #{path}|]
          ]
      else Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Text
name
  | Local {Text
Path Abs Dir
TemplateConfig
templateConfig :: TemplateConfig
name :: Text
path :: Path Abs Dir
templateConfig :: Template -> TemplateConfig
name :: Template -> Text
path :: Template -> Path Abs Dir
..} <- Template
template,
    TemplateConfig {[Pattern]
[Text]
[OptionalIgnores]
[Option]
Maybe Text
$sel:optionals:TemplateConfig :: TemplateConfig -> [OptionalIgnores]
$sel:options:TemplateConfig :: TemplateConfig -> [Option]
$sel:ignores:TemplateConfig :: TemplateConfig -> [Pattern]
$sel:tags:TemplateConfig :: TemplateConfig -> [Text]
$sel:desc:TemplateConfig :: TemplateConfig -> Maybe Text
optionals :: [OptionalIgnores]
options :: [Option]
ignores :: [Pattern]
tags :: [Text]
desc :: Maybe Text
..} <- TemplateConfig
templateConfig =
    if Bool
verbose
      then
        [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$
          [i|template: #{name}|] Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:
          [Doc a] -> (Text -> [Doc a]) -> Maybe Text -> [Doc a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
d -> Doc a -> [Doc a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [i|desc: #{d}|]) Maybe Text
desc
            [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep
              [ Doc a
"tags:",
                Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
mkBulletList ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Text -> Doc a) -> [Text] -> [Doc a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty [Text]
tags
              ] Doc a -> [Doc a] -> [Doc a]
forall a. a -> [a] -> [a]
:
          Doc a -> [Doc a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [i|path: #{path}|]
      else Text -> Doc a
forall a ann. Pretty a => a -> Doc ann
pretty Text
name

prettyTemplates :: Bool -> [Template] -> Doc a
prettyTemplates :: Bool -> [Template] -> Doc a
prettyTemplates Bool
verbose [Template]
templates =
  [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
vsep ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$
    [ Doc a
"- local templates",
      Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
mkBulletList [Doc a]
local
    ]
      [Doc a] -> [Doc a] -> [Doc a]
forall a. [a] -> [a] -> [a]
++ if [Doc a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Doc a]
broken
        then []
        else
          [ Doc a
"- broken templates",
            Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
mkBulletList [Doc a]
broken
          ]
  where
    isBroken :: Template -> Bool
isBroken Broken {} = Bool
True
    isBroken Template
_ = Bool
False
    isLocal :: Template -> Bool
isLocal Local {} = Bool
True
    isLocal Template
_ = Bool
False
    prettyP :: Template -> Doc a
prettyP = Bool -> Template -> Doc a
forall a. Bool -> Template -> Doc a
prettyTemplate Bool
verbose
    broken :: [Doc a]
broken = (Template -> Doc a) -> [Template] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Template -> Doc a
prettyP ([Template] -> [Doc a]) -> [Template] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (Template -> Bool) -> [Template] -> [Template]
forall a. (a -> Bool) -> [a] -> [a]
filter Template -> Bool
isBroken [Template]
templates
    local :: [Doc a]
local = (Template -> Doc a) -> [Template] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Template -> Doc a
prettyP ([Template] -> [Doc a]) -> [Template] -> [Doc a]
forall a b. (a -> b) -> a -> b
$ (Template -> Bool) -> [Template] -> [Template]
forall a. (a -> Bool) -> [a] -> [a]
filter Template -> Bool
isLocal [Template]
templates