{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Text.Mustache.Compile.TH
( compileMustacheDir,
compileMustacheDir',
compileMustacheFile,
compileMustacheText,
mustache,
)
where
import Control.Exception
import Data.Text (Text)
import qualified Data.Text as T
import Language.Haskell.TH hiding (Dec)
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax (addDependentFile, lift)
import System.Directory
import qualified Text.Mustache.Compile as C
import Text.Mustache.Type
compileMustacheDir ::
PName ->
FilePath ->
Q Exp
compileMustacheDir :: PName -> FilePath -> Q Exp
compileMustacheDir = (FilePath -> Bool) -> PName -> FilePath -> Q Exp
compileMustacheDir' FilePath -> Bool
C.isMustacheFile
compileMustacheDir' ::
(FilePath -> Bool) ->
PName ->
FilePath ->
Q Exp
compileMustacheDir' :: (FilePath -> Bool) -> PName -> FilePath -> Q Exp
compileMustacheDir' FilePath -> Bool
predicate PName
pname FilePath
path = do
IO [FilePath] -> Q [FilePath]
forall a. IO a -> Q a
runIO ((FilePath -> Bool) -> FilePath -> IO [FilePath]
forall (m :: * -> *).
MonadIO m =>
(FilePath -> Bool) -> FilePath -> m [FilePath]
C.getMustacheFilesInDir' FilePath -> Bool
predicate FilePath
path) Q [FilePath] -> ([FilePath] -> Q ()) -> Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Q ()) -> [FilePath] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Q ()
addDependentFile
(IO (Either MustacheException Template)
-> Q (Either MustacheException Template)
forall a. IO a -> Q a
runIO (IO (Either MustacheException Template)
-> Q (Either MustacheException Template))
-> (IO Template -> IO (Either MustacheException Template))
-> IO Template
-> Q (Either MustacheException Template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Template -> IO (Either MustacheException Template)
forall e a. Exception e => IO a -> IO (Either e a)
try) ((FilePath -> Bool) -> PName -> FilePath -> IO Template
forall (m :: * -> *).
MonadIO m =>
(FilePath -> Bool) -> PName -> FilePath -> m Template
C.compileMustacheDir' FilePath -> Bool
predicate PName
pname FilePath
path) Q (Either MustacheException Template)
-> (Either MustacheException Template -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either MustacheException Template -> Q Exp
handleEither
compileMustacheFile ::
FilePath ->
Q Exp
compileMustacheFile :: FilePath -> Q Exp
compileMustacheFile FilePath
path = do
IO FilePath -> Q FilePath
forall a. IO a -> Q a
runIO (FilePath -> IO FilePath
makeAbsolute FilePath
path) Q FilePath -> (FilePath -> Q ()) -> Q ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Q ()
addDependentFile
(IO (Either MustacheException Template)
-> Q (Either MustacheException Template)
forall a. IO a -> Q a
runIO (IO (Either MustacheException Template)
-> Q (Either MustacheException Template))
-> (IO Template -> IO (Either MustacheException Template))
-> IO Template
-> Q (Either MustacheException Template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Template -> IO (Either MustacheException Template)
forall e a. Exception e => IO a -> IO (Either e a)
try) (FilePath -> IO Template
forall (m :: * -> *). MonadIO m => FilePath -> m Template
C.compileMustacheFile FilePath
path) Q (Either MustacheException Template)
-> (Either MustacheException Template -> Q Exp) -> Q Exp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either MustacheException Template -> Q Exp
handleEither
compileMustacheText ::
PName ->
Text ->
Q Exp
compileMustacheText :: PName -> Text -> Q Exp
compileMustacheText PName
pname Text
text =
(Either MustacheException Template -> Q Exp
handleEither (Either MustacheException Template -> Q Exp)
-> (Either (ParseErrorBundle Text Void) Template
-> Either MustacheException Template)
-> Either (ParseErrorBundle Text Void) Template
-> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseErrorBundle Text Void -> Either MustacheException Template)
-> (Template -> Either MustacheException Template)
-> Either (ParseErrorBundle Text Void) Template
-> Either MustacheException Template
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (MustacheException -> Either MustacheException Template
forall a b. a -> Either a b
Left (MustacheException -> Either MustacheException Template)
-> (ParseErrorBundle Text Void -> MustacheException)
-> ParseErrorBundle Text Void
-> Either MustacheException Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> MustacheException
MustacheParserException) Template -> Either MustacheException Template
forall a b. b -> Either a b
Right)
(PName -> Text -> Either (ParseErrorBundle Text Void) Template
C.compileMustacheText PName
pname Text
text)
mustache :: QuasiQuoter
mustache :: QuasiQuoter
mustache =
QuasiQuoter :: (FilePath -> Q Exp)
-> (FilePath -> Q Pat)
-> (FilePath -> Q Type)
-> (FilePath -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: FilePath -> Q Exp
quoteExp = PName -> Text -> Q Exp
compileMustacheText PName
"quasi-quoted" (Text -> Q Exp) -> (FilePath -> Text) -> FilePath -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack,
quotePat :: FilePath -> Q Pat
quotePat = FilePath -> FilePath -> Q Pat
forall a. HasCallStack => FilePath -> a
error FilePath
"This usage is not supported.",
quoteType :: FilePath -> Q Type
quoteType = FilePath -> FilePath -> Q Type
forall a. HasCallStack => FilePath -> a
error FilePath
"This usage is not supported.",
quoteDec :: FilePath -> Q [Dec]
quoteDec = FilePath -> FilePath -> Q [Dec]
forall a. HasCallStack => FilePath -> a
error FilePath
"This usage is not supported."
}
handleEither :: Either MustacheException Template -> Q Exp
handleEither :: Either MustacheException Template -> Q Exp
handleEither Either MustacheException Template
val =
case Either MustacheException Template
val of
Left MustacheException
err -> (FilePath -> Q Exp
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Q Exp)
-> (MustacheException -> FilePath) -> MustacheException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
indentNicely (FilePath -> FilePath)
-> (MustacheException -> FilePath) -> MustacheException -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MustacheException -> FilePath
forall e. Exception e => e -> FilePath
displayException) MustacheException
err
Right Template
template -> Template -> Q Exp
forall t. Lift t => t -> Q Exp
lift Template
template
where
indentNicely :: FilePath -> FilePath
indentNicely FilePath
x' =
case FilePath -> [FilePath]
lines FilePath
x' of
[] -> FilePath
""
(FilePath
x : [FilePath]
xs) -> [FilePath] -> FilePath
unlines (FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
8 Char
' ' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
xs)