module Text.Microstache.Compile
( compileMustacheDir
, getMustacheFilesInDir
, compileMustacheFile
, compileMustacheText )
where
import Control.Exception (throwIO)
import Control.Monad (foldM, filterM)
import Data.Text.Lazy (Text)
import System.Directory
import Text.Parsec
import Text.Microstache.Parser
import Text.Microstache.Type
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import qualified System.FilePath as F
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
compileMustacheDir
:: PName
-> FilePath
-> IO Template
compileMustacheDir pname path =
getMustacheFilesInDir path >>=
fmap selectKey . foldM f (Template undefined M.empty)
where
selectKey t = t { templateActual = pname }
f (Template _ old) fp = do
Template _ new <- compileMustacheFile fp
return (Template undefined (M.union new old))
getMustacheFilesInDir
:: FilePath
-> IO [FilePath]
getMustacheFilesInDir path =
(getDirectoryContents path) >>=
filterM isMustacheFile . fmap (F.combine path) >>=
mapM makeAbsolute'
compileMustacheFile
:: FilePath
-> IO Template
compileMustacheFile path =
(TL.readFile path) >>= withException . compile
where
pname = pathToPName path
compile = fmap (Template pname . M.singleton pname) . parseMustache path
compileMustacheText
:: PName
-> Text
-> Either ParseError Template
compileMustacheText pname txt =
Template pname . M.singleton pname <$> parseMustache "" txt
isMustacheFile :: FilePath -> IO Bool
isMustacheFile path = do
exists <- doesFileExist path
let rightExtension = F.takeExtension path == ".mustache"
return (exists && rightExtension)
pathToPName :: FilePath -> PName
pathToPName = PName . T.pack . F.takeBaseName
withException
:: Either ParseError Template
-> IO Template
withException = either (throwIO . MustacheParserException) return
makeAbsolute' :: FilePath -> IO FilePath
makeAbsolute' path0 =
fmap (matchTrailingSeparator path0 . F.normalise) (prependCurrentDirectory path0)
where
prependCurrentDirectory :: FilePath -> IO FilePath
prependCurrentDirectory path =
if F.isRelative path
then (F.</> path) <$> getCurrentDirectory
else return path
matchTrailingSeparator :: FilePath -> FilePath -> FilePath
matchTrailingSeparator path
| F.hasTrailingPathSeparator path = F.addTrailingPathSeparator
| otherwise = F.dropTrailingPathSeparator