{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Text.Mustache.Compile.TH
-- Copyright   :  © 2016–present Stack Builders
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Template Haskell helpers to compile Mustache templates at compile time.
-- This module is not imported as part of "Text.Mustache", so you need to
-- import it yourself. Qualified import is recommended, but not necessary.
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

-- | Compile all templates in the specified directory and select one.
-- Template files should have the extension @mustache@, (e.g.
-- @foo.mustache@) to be recognized. This function /does not/ scan the
-- directory recursively.
--
-- This version compiles the templates at compile time.
--
-- > compileMustacheDir = compileMustacheDir' isMustacheFile
compileMustacheDir ::
  -- | Which template to select after compiling
  PName ->
  -- | Directory with templates
  FilePath ->
  -- | The resulting template
  Q Exp
compileMustacheDir :: PName -> FilePath -> Q Exp
compileMustacheDir = (FilePath -> Bool) -> PName -> FilePath -> Q Exp
compileMustacheDir' FilePath -> Bool
C.isMustacheFile

-- | The same as 'compileMustacheDir', but allows using a custom predicate
-- for template selection.
--
-- This version compiles the templates at compile time.
--
-- @since 1.2.0
compileMustacheDir' ::
  -- | Template selection predicate
  (FilePath -> Bool) ->
  -- | Which template to select after compiling
  PName ->
  -- | Directory with templates
  FilePath ->
  -- | The resulting template
  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

-- | Compile a Mustache template and select it.
--
-- This version compiles the template at compile time.
compileMustacheFile ::
  -- | Location of the file
  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

-- | Compile a Mustache template from 'Text' value. The cache will contain
-- only this template named according to given 'Key'.
--
-- This version compiles the template at compile time.
compileMustacheText ::
  -- | How to name the template?
  PName ->
  -- | The template to compile
  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)

-- | Compile a Mustache using a QuasiQuoter. Usage:
--
-- > {-# LANGUAGE QuasiQuotes #-}
-- > import Text.Mustache.Compile.TH (mustache)
-- >
-- > foo :: Template
-- > foo = [mustache|This is my inline {{ template }}.|]
--
-- Name of created partial is set to @"quasi-quoted"@. You can extend cache
-- of 'Template' created this way using @('Data.Semigroup.<>')@ and so work
-- with partials as usual.
--
-- @since 0.1.7
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."
    }

-- | Given an 'Either' result return 'Right' and signal pretty-printed error
-- if we have a 'Left'.
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)