-- |
-- Module      :  Text.Mustache.Compile
-- Copyright   :  © 2016–present Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Mustache 'Template' creation from file or a 'Text' value. You don't
-- usually need to import the module, because "Text.Mustache" re-exports
-- everything you may need, import that module instead.
module Text.Mustache.Compile
  ( compileMustacheDir,
    compileMustacheDir',
    getMustacheFilesInDir,
    getMustacheFilesInDir',
    isMustacheFile,
    compileMustacheFile,
    compileMustacheText,
  )
where

import Control.Exception
import Control.Monad (filterM, foldM)
import Control.Monad.IO.Class (MonadIO (..))
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Void
import System.Directory
import qualified System.FilePath as F
import Text.Megaparsec
import Text.Mustache.Parser
import Text.Mustache.Type

-- | Compile all templates in the specified directory and select one.
-- Template files should have the extension @mustache@, (e.g.
-- @foo.mustache@) to be recognized. This function /does not/ scan the
-- directory recursively.
--
-- Note that each template\/partial will get an identifier which consists of
-- the name of corresponding template file with extension @.mustache@
-- dropped. This is important for e.g. selecting active template after
-- loading (the first argument).
--
-- The action can throw 'MustacheParserException' and the same exceptions as
-- 'getDirectoryContents', and 'T.readFile'.
--
-- > compileMustacheDir = complieMustacheDir' isMustacheFile
compileMustacheDir ::
  (MonadIO m) =>
  -- | Which template to select after compiling
  PName ->
  -- | Directory with templates
  FilePath ->
  -- | The resulting template
  m Template
compileMustacheDir :: forall (m :: * -> *). MonadIO m => PName -> String -> m Template
compileMustacheDir = forall (m :: * -> *).
MonadIO m =>
(String -> Bool) -> PName -> String -> m Template
compileMustacheDir' String -> Bool
isMustacheFile

-- | The same as 'compileMustacheDir', but allows using a custom predicate
-- for template selection.
--
-- @since 1.2.0
compileMustacheDir' ::
  (MonadIO m) =>
  -- | Template selection predicate
  (FilePath -> Bool) ->
  -- | Which template to select after compiling
  PName ->
  -- | Directory with templates
  FilePath ->
  -- | The resulting template
  m Template
compileMustacheDir' :: forall (m :: * -> *).
MonadIO m =>
(String -> Bool) -> PName -> String -> m Template
compileMustacheDir' String -> Bool
predicate PName
pname String
path =
  forall (m :: * -> *).
MonadIO m =>
(String -> Bool) -> String -> m [String]
getMustacheFilesInDir' String -> Bool
predicate String
path
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template -> Template
selectKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}. MonadIO m => Template -> String -> m Template
f (PName -> Map PName [Node] -> Template
Template forall a. HasCallStack => a
undefined forall k a. Map k a
M.empty)
  where
    selectKey :: Template -> Template
selectKey Template
t = Template
t {templateActual :: PName
templateActual = PName
pname}
    f :: Template -> String -> m Template
f (Template PName
_ Map PName [Node]
old) String
fp = do
      Template PName
_ Map PName [Node]
new <- forall (m :: * -> *). MonadIO m => String -> m Template
compileMustacheFile String
fp
      forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Map PName [Node] -> Template
Template forall a. HasCallStack => a
undefined (forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map PName [Node]
new Map PName [Node]
old))

-- | Return a list of templates found in given a directory. The returned
-- paths are absolute.
--
-- @since 0.2.2
getMustacheFilesInDir ::
  (MonadIO m) =>
  -- | Directory with templates
  FilePath ->
  m [FilePath]
getMustacheFilesInDir :: forall (m :: * -> *). MonadIO m => String -> m [String]
getMustacheFilesInDir = forall (m :: * -> *).
MonadIO m =>
(String -> Bool) -> String -> m [String]
getMustacheFilesInDir' String -> Bool
isMustacheFile

-- | Return a list of templates that satisfy a predicate in a given
-- directory. The returned paths are absolute.
--
-- @since 1.2.0
getMustacheFilesInDir' ::
  (MonadIO m) =>
  -- | Mustache file selection predicate
  (FilePath -> Bool) ->
  -- | Directory with templates
  FilePath ->
  m [FilePath]
getMustacheFilesInDir' :: forall (m :: * -> *).
MonadIO m =>
(String -> Bool) -> String -> m [String]
getMustacheFilesInDir' String -> Bool
predicate String
path =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    String -> IO [String]
getDirectoryContents String
path
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
F.combine String
path)
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO String
makeAbsolute
  where
    f :: String -> IO Bool
f String
p = (Bool -> Bool -> Bool
&& String -> Bool
predicate String
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
p

-- | The default Mustache file predicate.
--
-- @since 1.2.0
isMustacheFile :: FilePath -> Bool
isMustacheFile :: String -> Bool
isMustacheFile String
path = String -> String
F.takeExtension String
path forall a. Eq a => a -> a -> Bool
== String
".mustache"

-- | Compile a Mustache template and select it.
--
-- The action can throw 'MustacheParserException' and the same exceptions as
-- 'T.readFile'.
compileMustacheFile ::
  (MonadIO m) =>
  -- | Location of the file
  FilePath ->
  m Template
compileMustacheFile :: forall (m :: * -> *). MonadIO m => String -> m Template
compileMustacheFile String
path = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  Text
input <- String -> IO Text
T.readFile String
path
  Either (ParseErrorBundle Text Void) Template -> IO Template
withException (Text -> Either (ParseErrorBundle Text Void) Template
compile Text
input)
  where
    pname :: PName
pname = String -> PName
pathToPName String
path
    compile :: Text -> Either (ParseErrorBundle Text Void) Template
compile = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PName -> Map PName [Node] -> Template
Template PName
pname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
M.singleton PName
pname) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Either (ParseErrorBundle Text Void) [Node]
parseMustache String
path

-- | Compile a Mustache template from a 'Text' value. The cache will contain
-- only this template named according to given 'PName'.
compileMustacheText ::
  -- | How to name the template?
  PName ->
  -- | The template to compile
  Text ->
  -- | The result
  Either (ParseErrorBundle Text Void) Template
compileMustacheText :: PName -> Text -> Either (ParseErrorBundle Text Void) Template
compileMustacheText PName
pname Text
txt =
  PName -> Map PName [Node] -> Template
Template PName
pname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. k -> a -> Map k a
M.singleton PName
pname forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text -> Either (ParseErrorBundle Text Void) [Node]
parseMustache String
"" Text
txt

----------------------------------------------------------------------------
-- Helpers

-- | Build a 'PName' from a given 'FilePath'.
pathToPName :: FilePath -> PName
pathToPName :: String -> PName
pathToPName = Text -> PName
PName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
F.takeBaseName

-- | Throw 'MustacheException' if the argument is 'Left' or return the
-- result inside 'Right'.
withException ::
  -- | Value to process
  Either (ParseErrorBundle Text Void) Template ->
  -- | The result
  IO Template
withException :: Either (ParseErrorBundle Text Void) Template -> IO Template
withException = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> MustacheException
MustacheParserException) forall (m :: * -> *) a. Monad m => a -> m a
return