-- |
-- Module      :  Text.Microstache.Compile
-- Copyright   :  © 2016–2017 Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov@openmailbox.org>
-- Stability   :  experimental
-- Portability :  portable
--
-- Mustache 'Template' creation from file or a 'Text' value. You don't
-- usually need to import the module, because "Text.Microstache" re-exports
-- everything you may need, import that module instead.

{-# LANGUAGE CPP #-}

module Text.Microstache.Compile
  ( compileMustacheDir
  , getMustacheFilesInDir
  , compileMustacheFile
  , compileMustacheText )
where

import Control.Exception       (throwIO)
import Control.Monad           (filterM, foldM)
import Data.Text.Lazy          (Text)
import System.Directory
import Text.Microstache.Parser
import Text.Microstache.Type
import Text.Parsec

import qualified Data.Map          as Map
import qualified Data.Text         as T
import qualified Data.Text.Lazy.IO as LT
import qualified System.FilePath   as F

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif

-- | Compile all templates in specified directory and select one. Template
-- files should have extension @mustache@, (e.g. @foo.mustache@) to be
-- recognized. This function /does not/ scan the directory recursively.
--
-- The action can throw the same exceptions as 'getDirectoryContents', and
-- 'T.readFile'.

compileMustacheDir
  :: PName             -- ^ Which template to select after compiling
  -> FilePath          -- ^ Directory with templates
  -> IO Template       -- ^ The resulting template
compileMustacheDir :: PName -> FilePath -> IO Template
compileMustacheDir PName
pname FilePath
path =
  FilePath -> IO [FilePath]
getMustacheFilesInDir FilePath
path IO [FilePath] -> ([FilePath] -> IO Template) -> IO Template
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (Template -> Template) -> IO Template -> IO Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Template -> Template
selectKey (IO Template -> IO Template)
-> ([FilePath] -> IO Template) -> [FilePath] -> IO Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Template -> FilePath -> IO Template)
-> Template -> [FilePath] -> IO Template
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Template -> FilePath -> IO Template
f (PName -> Map PName [Node] -> Template
Template PName
forall a. HasCallStack => a
undefined Map PName [Node]
forall k a. Map k a
Map.empty)
  where
    selectKey :: Template -> Template
selectKey Template
t = Template
t { templateActual :: PName
templateActual = PName
pname }
    f :: Template -> FilePath -> IO Template
f (Template PName
_ Map PName [Node]
old) FilePath
fp = do
      Template PName
_ Map PName [Node]
new <- FilePath -> IO Template
compileMustacheFile FilePath
fp
      Template -> IO Template
forall (m :: * -> *) a. Monad m => a -> m a
return (PName -> Map PName [Node] -> Template
Template PName
forall a. HasCallStack => a
undefined (Map PName [Node] -> Map PName [Node] -> Map PName [Node]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map PName [Node]
new Map PName [Node]
old))

-- | Return a list of templates found in given directory. The returned paths
-- are absolute.

getMustacheFilesInDir
  :: FilePath          -- ^ Directory with templates
  -> IO [FilePath]
getMustacheFilesInDir :: FilePath -> IO [FilePath]
getMustacheFilesInDir FilePath
path =
  FilePath -> IO [FilePath]
getDirectoryContents FilePath
path IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isMustacheFile ([FilePath] -> IO [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
F.combine FilePath
path) IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (FilePath -> IO FilePath) -> [FilePath] -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO FilePath
makeAbsolute'

-- | Compile single Mustache template and select it.
--
-- The action can throw the same exceptions as 'T.readFile'.

compileMustacheFile
  :: FilePath          -- ^ Location of the file
  -> IO Template
compileMustacheFile :: FilePath -> IO Template
compileMustacheFile FilePath
path =
    FilePath -> IO Text
LT.readFile FilePath
path IO Text -> (Text -> IO Template) -> IO Template
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ParseError Template -> IO Template
withException (Either ParseError Template -> IO Template)
-> (Text -> Either ParseError Template) -> Text -> IO Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseError Template
compile
  where
    pname :: PName
pname = FilePath -> PName
pathToPName FilePath
path
    compile :: Text -> Either ParseError Template
compile = ([Node] -> Template)
-> Either ParseError [Node] -> Either ParseError Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PName -> Map PName [Node] -> Template
Template PName
pname (Map PName [Node] -> Template)
-> ([Node] -> Map PName [Node]) -> [Node] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PName -> [Node] -> Map PName [Node]
forall k a. k -> a -> Map k a
Map.singleton PName
pname) (Either ParseError [Node] -> Either ParseError Template)
-> (Text -> Either ParseError [Node])
-> Text
-> Either ParseError Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Either ParseError [Node]
parseMustache FilePath
path

-- | Compile Mustache template from a lazy 'Text' value. The cache will
-- contain only this template named according to given 'PName'.

compileMustacheText
  :: PName             -- ^ How to name the template?
  -> Text              -- ^ The template to compile
  -> Either ParseError Template -- ^ The result
compileMustacheText :: PName -> Text -> Either ParseError Template
compileMustacheText PName
pname Text
txt =
  PName -> Map PName [Node] -> Template
Template PName
pname (Map PName [Node] -> Template)
-> ([Node] -> Map PName [Node]) -> [Node] -> Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PName -> [Node] -> Map PName [Node]
forall k a. k -> a -> Map k a
Map.singleton PName
pname ([Node] -> Template)
-> Either ParseError [Node] -> Either ParseError Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Text -> Either ParseError [Node]
parseMustache FilePath
"" Text
txt

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

-- | Check if given 'FilePath' points to a mustache file.

isMustacheFile :: FilePath -> IO Bool
isMustacheFile :: FilePath -> IO Bool
isMustacheFile FilePath
path = do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
  let rightExtension :: Bool
rightExtension = FilePath -> FilePath
F.takeExtension FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".mustache"
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
exists Bool -> Bool -> Bool
&& Bool
rightExtension)

-- | Build a 'PName' from given 'FilePath'.

pathToPName :: FilePath -> PName
pathToPName :: FilePath -> PName
pathToPName = Text -> PName
PName (Text -> PName) -> (FilePath -> Text) -> FilePath -> PName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
F.takeBaseName

-- | Throw 'MustacheException' if argument is 'Left' or return the result
-- inside 'Right'.

withException
  :: Either ParseError Template -- ^ Value to process
  -> IO Template        -- ^ The result
withException :: Either ParseError Template -> IO Template
withException = (ParseError -> IO Template)
-> (Template -> IO Template)
-> Either ParseError Template
-> IO Template
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MustacheException -> IO Template
forall e a. Exception e => e -> IO a
throwIO (MustacheException -> IO Template)
-> (ParseError -> MustacheException) -> ParseError -> IO Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> MustacheException
MustacheParserException) Template -> IO Template
forall (m :: * -> *) a. Monad m => a -> m a
return

makeAbsolute' :: FilePath -> IO FilePath
makeAbsolute' :: FilePath -> IO FilePath
makeAbsolute' FilePath
path0 =
    (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
matchTrailingSeparator FilePath
path0 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
F.normalise) (FilePath -> IO FilePath
prependCurrentDirectory FilePath
path0)
  where
    prependCurrentDirectory :: FilePath -> IO FilePath
    prependCurrentDirectory :: FilePath -> IO FilePath
prependCurrentDirectory FilePath
path =
      if FilePath -> Bool
F.isRelative FilePath
path -- avoid the call to `getCurrentDirectory` if we can
      then (FilePath -> FilePath -> FilePath
F.</> FilePath
path) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
      else FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path

    matchTrailingSeparator :: FilePath -> FilePath -> FilePath
    matchTrailingSeparator :: FilePath -> FilePath -> FilePath
matchTrailingSeparator FilePath
path
      | FilePath -> Bool
F.hasTrailingPathSeparator FilePath
path = FilePath -> FilePath
F.addTrailingPathSeparator
      | Bool
otherwise                       = FilePath -> FilePath
F.dropTrailingPathSeparator