module Text.Mustache.Compile
( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache
, compileTemplate, cacheFromList, getPartials, getFile
) where
import Control.Arrow ((&&&))
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Trans.Either
import Control.Monad.Unicode
import Data.Bool
import Data.Function.JAExtra
import Data.HashMap.Strict as HM
import Data.Monoid.Unicode ((∅))
import Data.Text hiding (concat, find, map, uncons)
import qualified Data.Text.IO as TIO
import Prelude.Unicode
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
automaticCompile ∷ [FilePath] → FilePath → IO (Either ParseError Template)
automaticCompile searchSpace = compileTemplateWithCache searchSpace (∅)
localAutomaticCompile ∷ FilePath → IO (Either ParseError Template)
localAutomaticCompile = automaticCompile ["."]
compileTemplateWithCache ∷ [FilePath]
→ TemplateCache
→ FilePath
→ IO (Either ParseError Template)
compileTemplateWithCache searchSpace templates initName =
runEitherT $ evalStateT (compile' initName) $ flattenPartials templates
where
compile' ∷ FilePath
→ StateT
(HM.HashMap String Template)
(EitherT ParseError IO)
Template
compile' name' = do
templates' ← get
case HM.lookup name' templates' of
Just template → return template
Nothing → do
rawSource ← lift $ getFile searchSpace name'
compiled@(Template { ast = mSTree }) ←
lift $ hoistEither $ compileTemplate name' rawSource
foldM
(\st@(Template { partials = p }) partialName → do
nt ← compile' partialName
modify (HM.insert partialName nt)
return (st { partials = HM.insert partialName nt p })
)
compiled
(getPartials mSTree)
cacheFromList ∷ [Template] → TemplateCache
cacheFromList = flattenPartials ∘ fromList ∘ fmap (name &&& id)
compileTemplate ∷ String → Text → Either ParseError Template
compileTemplate name' = fmap (flip (Template name') (∅)) ∘ parse name'
getPartials ∷ STree → [FilePath]
getPartials = join ∘ fmap getPartials'
getPartials' ∷ Node Text → [FilePath]
getPartials' (Partial _ p) = return p
getPartials' (Section _ n) = getPartials n
getPartials' (InvertedSection _ n) = getPartials n
getPartials' _ = (∅)
flattenPartials ∷ TemplateCache → TemplateCache
flattenPartials = stuffWith $ foldrWithKey $ insertWith discard
getFile ∷ [FilePath] → FilePath → EitherT ParseError IO Text
getFile [] fp = throwError $ fileNotFound fp
getFile (templateDir : xs) fp =
lift (doesFileExist filePath) ≫=
bool
(getFile xs fp)
(lift $ TIO.readFile filePath)
where
filePath = templateDir </> fp
fileNotFound ∷ FilePath → ParseError
fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp)