{-|
Module      : $Header$
Description : Basic functions for dealing with mustache templates.
Copyright   : (c) Justus Adam, 2015
License     : BSD3
Maintainer  : dev@justus.science
Stability   : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Mustache.Compile
  ( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache
  , compileTemplate, cacheFromList, getPartials, mustache, embedTemplate, embedSingleTemplate
  ) where


import           Control.Arrow              ((&&&))
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.State
import           Data.Bool
import           Data.HashMap.Strict        as HM
import           Data.Text                  hiding (concat, find, map, uncons)
import qualified Data.Text.IO               as TIO
import           Language.Haskell.TH        (Exp, Loc, Q, loc_filename,
                                             loc_start, location)
import           Language.Haskell.TH.Quote  (QuasiQuoter (QuasiQuoter),
                                             quoteExp)
import qualified Language.Haskell.TH.Syntax as THS
import           System.Directory
import           System.FilePath
import           Text.Mustache.Parser
import           Text.Mustache.Types
import           Text.Parsec.Error
import           Text.Parsec.Pos
import           Text.Printf

{-|
  Compiles a mustache template provided by name including the mentioned partials.

  The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'.

  This function also ensures each partial is only compiled once even though it may
  be included by other partials including itself.

  A reference to the included template will be found in each including templates
  'partials' section.
-}
automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile [FilePath]
searchSpace = [FilePath]
-> TemplateCache -> FilePath -> IO (Either ParseError Template)
compileTemplateWithCache [FilePath]
searchSpace forall a. Monoid a => a
mempty


-- | Compile the template with the search space set to only the current directory
localAutomaticCompile :: FilePath -> IO (Either ParseError Template)
localAutomaticCompile :: FilePath -> IO (Either ParseError Template)
localAutomaticCompile = [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile [FilePath
"."]


{-|
  Compile a mustache template providing a list of precompiled templates that do
  not have to be recompiled.
-}
compileTemplateWithCache :: [FilePath]
                         -> TemplateCache
                         -> FilePath
                         -> IO (Either ParseError Template)
compileTemplateWithCache :: [FilePath]
-> TemplateCache -> FilePath -> IO (Either ParseError Template)
compileTemplateWithCache [FilePath]
searchSpace TemplateCache
templates FilePath
initName =
  forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
compile' FilePath
initName) forall a b. (a -> b) -> a -> b
$ TemplateCache -> TemplateCache
flattenPartials TemplateCache
templates
  where
    compile' :: FilePath
             -> StateT
                (HM.HashMap String Template)
                (ExceptT ParseError IO)
                Template
    compile' :: FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
compile' FilePath
name' = do
      TemplateCache
templates' <- forall s (m :: * -> *). MonadState s m => m s
get
      case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup FilePath
name' TemplateCache
templates' of
        Just Template
template -> forall (m :: * -> *) a. Monad m => a -> m a
return Template
template
        Maybe Template
Nothing -> do
          Text
rawSource <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath -> ExceptT ParseError IO Text
getFile [FilePath]
searchSpace FilePath
name'
          compiled :: Template
compiled@(Template { ast :: Template -> STree
ast = STree
mSTree }) <-
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either ParseError Template
compileTemplate FilePath
name' Text
rawSource

          forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
            (\st :: Template
st@(Template { partials :: Template -> TemplateCache
partials = TemplateCache
p }) FilePath
partialName -> do
              Template
nt <- FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
compile' FilePath
partialName
              forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FilePath
partialName Template
nt)
              forall (m :: * -> *) a. Monad m => a -> m a
return (Template
st { partials :: TemplateCache
partials = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert FilePath
partialName Template
nt TemplateCache
p })
            )
            Template
compiled
            (STree -> [FilePath]
getPartials STree
mSTree)


-- | Flatten a list of Templates into a single 'TemplateCache'
cacheFromList :: [Template] -> TemplateCache
cacheFromList :: [Template] -> TemplateCache
cacheFromList = TemplateCache -> TemplateCache
flattenPartials forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Template -> FilePath
name forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)


-- | Compiles a 'Template' directly from 'Text' without checking for missing partials.
-- the result will be a 'Template' with an empty 'partials' cache.
compileTemplate :: String -> Text -> Either ParseError Template
compileTemplate :: FilePath -> Text -> Either ParseError Template
compileTemplate FilePath
name' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip (FilePath -> STree -> TemplateCache -> Template
Template FilePath
name') forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> Either ParseError STree
parse FilePath
name'


{-|
  Find the names of all included partials in a mustache STree.

  Same as @join . fmap getPartials'@
-}
getPartials :: STree -> [FilePath]
getPartials :: STree -> [FilePath]
getPartials = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node Text -> [FilePath]
getPartials'


{-|
  Find partials in a single Node
-}
getPartials' :: Node Text -> [FilePath]
getPartials' :: Node Text -> [FilePath]
getPartials' (Partial Maybe Text
_ FilePath
p) = forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
p
getPartials' (Section DataIdentifier
_ STree
n) = STree -> [FilePath]
getPartials STree
n
getPartials' (InvertedSection DataIdentifier
_ STree
n) = STree -> [FilePath]
getPartials STree
n
getPartials' Node Text
_                     = forall a. Monoid a => a
mempty


flattenPartials :: TemplateCache -> TemplateCache
flattenPartials :: TemplateCache -> TemplateCache
flattenPartials TemplateCache
m = forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
foldrWithKey (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
insertWith (\Template
_ Template
b -> Template
b)) TemplateCache
m TemplateCache
m


{-|
  @getFile searchSpace file@ iteratively searches all directories in
  @searchSpace@ for a @file@ returning it if found or raising an error if none
  of the directories contain the file.

  This trows 'ParseError's to be compatible with the internal Either Monad of
  'compileTemplateWithCache'.
-}
getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text
getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text
getFile [] FilePath
fp = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ FilePath -> ParseError
fileNotFound FilePath
fp
getFile (FilePath
templateDir : [FilePath]
xs) FilePath
fp =
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> IO Bool
doesFileExist FilePath
filePath) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    forall a. a -> a -> Bool -> a
bool
      ([FilePath] -> FilePath -> ExceptT ParseError IO Text
getFile [FilePath]
xs FilePath
fp)
      (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
TIO.readFile FilePath
filePath)
  where
    filePath :: FilePath
filePath = FilePath
templateDir FilePath -> FilePath -> FilePath
</> FilePath
fp


-- |
-- Compile a mustache 'Template' at compile time. Usage:
--
-- > {-# LANGUAGE QuasiQuotes #-}
-- > import Text.Mustache.Compile (mustache)
-- >
-- > foo :: Template
-- > foo = [mustache|This is my inline {{ template }} created at compile time|]
--
-- Partials are not supported in the QuasiQuoter

mustache :: QuasiQuoter
mustache :: QuasiQuoter
mustache = QuasiQuoter {quoteExp :: FilePath -> Q Exp
quoteExp = \FilePath
unprocessedTemplate -> do
  Loc
l <- Q Loc
location
  FilePath -> FilePath -> Q Exp
compileTemplateTH (Loc -> FilePath
fileAndLine Loc
l) FilePath
unprocessedTemplate }

-- |
-- Compile a mustache 'Template' at compile time providing a search space for any partials. Usage:
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > import Text.Mustache.Compile (embedTemplate)
-- >
-- > foo :: Template
-- > foo = $(embedTemplate ["dir", "dir/partials"] "file.mustache")
--

embedTemplate :: [FilePath] -> FilePath -> Q Exp
embedTemplate :: [FilePath] -> FilePath -> Q Exp
embedTemplate [FilePath]
searchSpace FilePath
filename = do
  Template
template <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Parse error in mustache template: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Q a
THS.runIO ([FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile [FilePath]
searchSpace FilePath
filename)
  let possiblePaths :: [FilePath]
possiblePaths = do
        FilePath
fname <- (FilePath
filenameforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [k]
HM.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> TemplateCache
partials forall a b. (a -> b) -> a -> b
$ Template
template
        FilePath
path <- [FilePath]
searchSpace
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
fname
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Q ()
addDependentRelativeFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Q a
THS.runIO (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist [FilePath]
possiblePaths)
  forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
THS.lift Template
template

-- |
-- Compile a mustache 'Template' at compile time. Usage:
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > import Text.Mustache.Compile (embedSingleTemplate)
-- >
-- > foo :: Template
-- > foo = $(embedSingleTemplate "dir/file.mustache")
--
-- Partials are not supported in embedSingleTemplate

embedSingleTemplate :: FilePath -> Q Exp
embedSingleTemplate :: FilePath -> Q Exp
embedSingleTemplate FilePath
filePath = do
  FilePath -> Q ()
addDependentRelativeFile FilePath
filePath
  FilePath -> FilePath -> Q Exp
compileTemplateTH FilePath
filePath forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO a -> Q a
THS.runIO (FilePath -> IO FilePath
readFile FilePath
filePath)

fileAndLine :: Loc -> String
fileAndLine :: Loc -> FilePath
fileAndLine Loc
loc = Loc -> FilePath
loc_filename Loc
loc forall a. [a] -> [a] -> [a]
++ FilePath
":" forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> CharPos
loc_start forall a b. (a -> b) -> a -> b
$ Loc
loc)

compileTemplateTH :: String -> String -> Q Exp
compileTemplateTH :: FilePath -> FilePath -> Q Exp
compileTemplateTH FilePath
filename FilePath
unprocessed =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"Parse error in mustache template: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
THS.lift forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Either ParseError Template
compileTemplate FilePath
filename (FilePath -> Text
pack FilePath
unprocessed)

addDependentRelativeFile :: FilePath -> Q ()
addDependentRelativeFile :: FilePath -> Q ()
addDependentRelativeFile = forall (m :: * -> *). Quasi m => FilePath -> m ()
THS.qAddDependentFile forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. IO a -> Q a
THS.runIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
makeAbsolute

-- ERRORS

fileNotFound :: FilePath -> ParseError
fileNotFound :: FilePath -> ParseError
fileNotFound FilePath
fp = Message -> SourcePos -> ParseError
newErrorMessage (FilePath -> Message
Message forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf FilePath
"Template file '%s' not found" FilePath
fp) (FilePath -> SourcePos
initialPos FilePath
fp)