module Text.Mustache.Compile
( automaticCompile, localAutomaticCompile, TemplateCache, compileTemplateWithCache
, compileTemplate, cacheFromList, getPartials, getFile, mustache, embedTemplate, embedSingleTemplate
) where
import Control.Arrow ((&&&))
import Control.Monad
import Control.Monad.Except
import Control.Monad.State
import Control.Monad.Trans.Either
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
automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
automaticCompile searchSpace = compileTemplateWithCache searchSpace mempty
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') mempty) . 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' _ = mempty
flattenPartials :: TemplateCache -> TemplateCache
flattenPartials m = foldrWithKey (insertWith (\_ b -> b)) m m
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
mustache :: QuasiQuoter
mustache = QuasiQuoter {quoteExp = \unprocessedTemplate -> do
l <- location
compileTemplateTH (fileAndLine l) unprocessedTemplate }
embedTemplate :: [FilePath] -> FilePath -> Q Exp
embedTemplate searchSpace filename = do
template <- either (fail . ("Parse error in mustache template: " ++) . show) pure =<< THS.runIO (automaticCompile searchSpace filename)
let possiblePaths = do
fname <- (filename:) . HM.keys . partials $ template
path <- searchSpace
pure $ path </> fname
mapM_ addDependentRelativeFile =<< THS.runIO (filterM doesFileExist possiblePaths)
THS.lift template
embedSingleTemplate :: FilePath -> Q Exp
embedSingleTemplate filePath = do
addDependentRelativeFile filePath
compileTemplateTH filePath =<< THS.runIO (readFile filePath)
fileAndLine :: Loc -> String
fileAndLine loc = loc_filename loc ++ ":" ++ (show . fst . loc_start $ loc)
compileTemplateTH :: String -> String -> Q Exp
compileTemplateTH filename unprocessed =
either (fail . ("Parse error in mustache template: " ++) . show) THS.lift $ compileTemplate filename (pack unprocessed)
addDependentRelativeFile :: FilePath -> Q ()
addDependentRelativeFile = THS.qAddDependentFile <=< THS.runIO . makeAbsolute
fileNotFound :: FilePath -> ParseError
fileNotFound fp = newErrorMessage (Message $ printf "Template file '%s' not found" fp) (initialPos fp)