    {-|
    Module      : $Header$
    Description : Basic functions for dealing with mustache templates.
    Copyright   : (c) Justus Adam, 2015
    License     : BSD3
    Maintainer  : dev@justus.science
    Stability   : experimental
    Portability : POSIX
    -}
    {-# OPTIONS_GHC -fno-warn-missing-fields #-}
    module Text.Mustache.Compile
      ( automaticCompile
      , localAutomaticCompile
      , TemplateCache
      , compileTemplateWithCache
      , compileTemplate
      , cacheFromList
      , getPartials
      , mustache
      , embedTemplate
      , embedSingleTemplate
      ) where

    import           Control.Arrow ( (&&&) )
    import           Control.Monad ( (<=<), filterM, foldM )
    import           Control.Monad.Except
                       ( ExceptT (..), MonadError (..), runExceptT )
    import           Control.Monad.State
                       ( MonadState (..), MonadTrans (..), StateT, evalStateT
                       , modify
                       )
    import           Data.Bool ( bool )
    import qualified Data.HashMap.Strict as HM
    import           Data.Text ( Text )
    import qualified Data.Text as T
    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 (..), quoteExp )
    import qualified Language.Haskell.TH.Syntax as THS
    import           System.Directory ( doesFileExist, makeAbsolute )
    import           System.FilePath ( (</>) )
    import           Text.Mustache.Parser ( parse )
    import           Text.Mustache.Types
                       ( STree, Template (..), TemplateCache, Node (..) )
    import           Text.Parsec.Error ( Message (..), ParseError, newErrorMessage )
    import           Text.Parsec.Pos ( initialPos )
    import           Text.Printf ( printf )

    {-|
      Compiles a mustache template provided by name including the mentioned partials.

      The same can be done manually using 'getFile', 'mustacheParser' and 'getPartials'.

      This function also ensures each partial is only compiled once even though it may
      be included by other partials including itself.

      A reference to the included template will be found in each including templates
      'partials' section.
    -}
    automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
    automaticCompile :: [FilePath] -> FilePath -> IO (Either ParseError Template)
    automaticCompile [FilePath]
    searchSpace = [FilePath]
    -> TemplateCache -> FilePath -> IO (Either ParseError Template)
    compileTemplateWithCache [FilePath]
    searchSpace TemplateCache
    forall a. Monoid a => a
    mempty

    -- | Compile the template with the search space set to only the current directory

    localAutomaticCompile :: FilePath -> IO (Either ParseError Template)
    localAutomaticCompile :: FilePath -> IO (Either ParseError Template)
    localAutomaticCompile = [FilePath] -> FilePath -> IO (Either ParseError Template)
    automaticCompile [FilePath
    "."]

    {-|
      Compile a mustache template providing a list of precompiled templates that do
      not have to be recompiled.
    -}
    compileTemplateWithCache :: [FilePath]
                             -> TemplateCache
                             -> FilePath
                             -> IO (Either ParseError Template)
    compileTemplateWithCache :: [FilePath]
    -> TemplateCache -> FilePath -> IO (Either ParseError Template)
    compileTemplateWithCache [FilePath]
    searchSpace TemplateCache
    templates FilePath
    initName =
      ExceptT ParseError IO Template -> IO (Either ParseError Template)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT ParseError IO Template -> IO (Either ParseError Template))
    -> ExceptT ParseError IO Template
    -> IO (Either ParseError Template)
    forall a b. (a -> b) -> a -> b
    $ StateT TemplateCache (ExceptT ParseError IO) Template
    -> TemplateCache -> ExceptT ParseError IO Template
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT (FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
    compile' FilePath
    initName) (TemplateCache -> ExceptT ParseError IO Template)
    -> TemplateCache -> ExceptT ParseError IO Template
    forall a b. (a -> b) -> a -> b
    $ TemplateCache -> TemplateCache
    flattenPartials TemplateCache
    templates
      where
        compile' :: FilePath
                 -> StateT
                    (HM.HashMap String Template)
                    (ExceptT ParseError IO)
                    Template
        compile' :: FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
    compile' FilePath
    name' = do
          templates' <- StateT TemplateCache (ExceptT ParseError IO) TemplateCache
    forall s (m :: * -> *). MonadState s m => m s
    get
          case HM.lookup name' templates' of
            Just Template
    template -> Template -> StateT TemplateCache (ExceptT ParseError IO) Template
    forall a. a -> StateT TemplateCache (ExceptT ParseError IO) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Template
    template
            Maybe Template
    Nothing -> do
              rawSource <- ExceptT ParseError IO Text
    -> StateT TemplateCache (ExceptT ParseError IO) Text
    forall (m :: * -> *) a. Monad m => m a -> StateT TemplateCache m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ExceptT ParseError IO Text
     -> StateT TemplateCache (ExceptT ParseError IO) Text)
    -> ExceptT ParseError IO Text
    -> StateT TemplateCache (ExceptT ParseError IO) Text
    forall a b. (a -> b) -> a -> b
    $ [FilePath] -> FilePath -> ExceptT ParseError IO Text
    getFile [FilePath]
    searchSpace FilePath
    name'
              compiled@(Template { ast = mSTree }) <-
                lift $ ExceptT . pure $ compileTemplate name' rawSource

              foldM
                (\st :: Template
    st@(Template { partials :: Template -> TemplateCache
    partials = TemplateCache
    p }) FilePath
    partialName -> do
                  nt <- FilePath -> StateT TemplateCache (ExceptT ParseError IO) Template
    compile' FilePath
    partialName
                  modify (HM.insert partialName nt)
                  pure (st { partials = HM.insert partialName nt p })
                )
                compiled
                (getPartials mSTree)

    -- | Flatten a list of Templates into a single 'TemplateCache'

    cacheFromList :: [Template] -> TemplateCache
    cacheFromList :: [Template] -> TemplateCache
    cacheFromList = TemplateCache -> TemplateCache
    flattenPartials (TemplateCache -> TemplateCache)
    -> ([Template] -> TemplateCache) -> [Template] -> TemplateCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(FilePath, Template)] -> TemplateCache
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    HM.fromList ([(FilePath, Template)] -> TemplateCache)
    -> ([Template] -> [(FilePath, Template)])
    -> [Template]
    -> TemplateCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Template -> (FilePath, Template))
    -> [Template] -> [(FilePath, Template)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Template -> FilePath
    name (Template -> FilePath)
    -> (Template -> Template) -> Template -> (FilePath, Template)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& Template -> Template
    forall a. a -> a
    id)

    -- | Compiles a 'Template' directly from 'Text' without checking for missing partials.

    -- the result will be a 'Template' with an empty 'partials' cache.

    compileTemplate :: String -> Text -> Either ParseError Template
    compileTemplate :: FilePath -> Text -> Either ParseError Template
    compileTemplate FilePath
    name' = (STree -> Template)
    -> Either ParseError STree -> Either ParseError Template
    forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((STree -> TemplateCache -> Template)
    -> TemplateCache -> STree -> Template
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (FilePath -> STree -> TemplateCache -> Template
    Template FilePath
    name') TemplateCache
    forall a. Monoid a => a
    mempty) (Either ParseError STree -> Either ParseError Template)
    -> (Text -> Either ParseError STree)
    -> Text
    -> Either ParseError Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Text -> Either ParseError STree
    parse FilePath
    name'

    {-|
      Find the names of all included partials in a mustache STree.

      Same as @join . fmap getPartials'@
    -}
    getPartials :: STree -> [FilePath]
    getPartials :: STree -> [FilePath]
    getPartials = (Node Text -> [FilePath]
    getPartials' (Node Text -> [FilePath]) -> STree -> [FilePath]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<)

    {-|
      Find partials in a single Node
    -}
    getPartials' :: Node Text -> [FilePath]
    getPartials' :: Node Text -> [FilePath]
    getPartials' (Partial Maybe Text
    _ FilePath
    p) = FilePath -> [FilePath]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FilePath
    p
    getPartials' (Section DataIdentifier
    _ STree
    n) = STree -> [FilePath]
    getPartials STree
    n
    getPartials' (InvertedSection DataIdentifier
    _ STree
    n) = STree -> [FilePath]
    getPartials STree
    n
    getPartials' Node Text
    _                     = [FilePath]
    forall a. Monoid a => a
    mempty

    flattenPartials :: TemplateCache -> TemplateCache
    flattenPartials :: TemplateCache -> TemplateCache
    flattenPartials TemplateCache
    m = (FilePath -> Template -> TemplateCache -> TemplateCache)
    -> TemplateCache -> TemplateCache -> TemplateCache
    forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
    HM.foldrWithKey ((Template -> Template -> Template)
    -> FilePath -> Template -> TemplateCache -> TemplateCache
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    HM.insertWith (\Template
    _ Template
    b -> Template
    b)) TemplateCache
    m TemplateCache
    m

    {-|
      @getFile searchSpace file@ iteratively searches all directories in
      @searchSpace@ for a @file@ returning it if found or raising an error if none
      of the directories contain the file.

      This trows 'ParseError's to be compatible with the internal Either Monad of
      'compileTemplateWithCache'.
    -}
    getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text
    getFile :: [FilePath] -> FilePath -> ExceptT ParseError IO Text
    getFile [] FilePath
    fp = ParseError -> ExceptT ParseError IO Text
    forall a. ParseError -> ExceptT ParseError IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (ParseError -> ExceptT ParseError IO Text)
    -> ParseError -> ExceptT ParseError IO Text
    forall a b. (a -> b) -> a -> b
    $ FilePath -> ParseError
    fileNotFound FilePath
    fp
    getFile (FilePath
    templateDir : [FilePath]
    xs) FilePath
    fp =
      IO Bool -> ExceptT ParseError IO Bool
    forall (m :: * -> *) a. Monad m => m a -> ExceptT ParseError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (FilePath -> IO Bool
    doesFileExist FilePath
    filePath) ExceptT ParseError IO Bool
    -> (Bool -> ExceptT ParseError IO Text)
    -> ExceptT ParseError IO Text
    forall a b.
    ExceptT ParseError IO a
    -> (a -> ExceptT ParseError IO b) -> ExceptT ParseError IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
        ExceptT ParseError IO Text
    -> ExceptT ParseError IO Text -> Bool -> ExceptT ParseError IO Text
    forall a. a -> a -> Bool -> a
    bool
          ([FilePath] -> FilePath -> ExceptT ParseError IO Text
    getFile [FilePath]
    xs FilePath
    fp)
          (IO Text -> ExceptT ParseError IO Text
    forall (m :: * -> *) a. Monad m => m a -> ExceptT ParseError m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO Text -> ExceptT ParseError IO Text)
    -> IO Text -> ExceptT ParseError IO Text
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO Text
    TIO.readFile FilePath
    filePath)
      where
        filePath :: FilePath
    filePath = FilePath
    templateDir FilePath -> FilePath -> FilePath
    </> FilePath
    fp

    -- |

    -- Compile a mustache 'Template' at compile time. Usage:

    --

    -- > {-# LANGUAGE QuasiQuotes #-}

    -- > import Text.Mustache.Compile (mustache)

    -- >

    -- > foo :: Template

    -- > foo = [mustache|This is my inline {{ template }} created at compile time|]

    --

    -- Partials are not supported in the QuasiQuoter

    mustache :: QuasiQuoter
    mustache :: QuasiQuoter
    mustache = QuasiQuoter {quoteExp :: FilePath -> Q Exp
    quoteExp = \FilePath
    unprocessedTemplate -> do
      l <- Q Loc
    location
      compileTemplateTH (fileAndLine l) unprocessedTemplate }

    -- |

    -- Compile a mustache 'Template' at compile time providing a search space for

    -- any partials. Usage:

    --

    -- > {-# LANGUAGE TemplateHaskell #-}

    -- > import Text.Mustache.Compile (embedTemplate)

    -- >

    -- > foo :: Template

    -- > foo = $(embedTemplate ["dir", "dir/partials"] "file.mustache")

    --

    embedTemplate :: [FilePath] -> FilePath -> Q Exp
    embedTemplate :: [FilePath] -> FilePath -> Q Exp
    embedTemplate [FilePath]
    searchSpace FilePath
    filename = do
      template <- (ParseError -> Q Template)
    -> (Template -> Q Template)
    -> Either ParseError Template
    -> Q Template
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (FilePath -> Q Template
    forall a. FilePath -> Q a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Q Template)
    -> (ParseError -> FilePath) -> ParseError -> Q Template
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath
    "Parse error in mustache template: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) (FilePath -> FilePath)
    -> (ParseError -> FilePath) -> ParseError -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> FilePath
    forall a. Show a => a -> FilePath
    show) Template -> Q Template
    forall a. a -> Q a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either ParseError Template -> Q Template)
    -> Q (Either ParseError Template) -> Q Template
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO (Either ParseError Template) -> Q (Either ParseError Template)
    forall a. IO a -> Q a
    THS.runIO ([FilePath] -> FilePath -> IO (Either ParseError Template)
    automaticCompile [FilePath]
    searchSpace FilePath
    filename)
      let possiblePaths = do
            fname <- (FilePath
    filenameFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :) ([FilePath] -> [FilePath])
    -> (Template -> [FilePath]) -> Template -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TemplateCache -> [FilePath]
    forall k v. HashMap k v -> [k]
    HM.keys (TemplateCache -> [FilePath])
    -> (Template -> TemplateCache) -> Template -> [FilePath]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Template -> TemplateCache
    partials (Template -> [FilePath]) -> Template -> [FilePath]
    forall a b. (a -> b) -> a -> b
    $ Template
    template
            path <- searchSpace
            pure $ path </> fname
      mapM_ addDependentRelativeFile =<< THS.runIO (filterM doesFileExist possiblePaths)
      THS.lift template

    -- |

    -- Compile a mustache 'Template' at compile time. Usage:

    --

    -- > {-# LANGUAGE TemplateHaskell #-}

    -- > import Text.Mustache.Compile (embedSingleTemplate)

    -- >

    -- > foo :: Template

    -- > foo = $(embedSingleTemplate "dir/file.mustache")

    --

    -- Partials are not supported in embedSingleTemplate

    embedSingleTemplate :: FilePath -> Q Exp
    embedSingleTemplate :: FilePath -> Q Exp
    embedSingleTemplate FilePath
    filePath = do
      FilePath -> Q ()
    addDependentRelativeFile FilePath
    filePath
      FilePath -> FilePath -> Q Exp
    compileTemplateTH FilePath
    filePath (FilePath -> Q Exp) -> Q FilePath -> Q Exp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO FilePath -> Q FilePath
    forall a. IO a -> Q a
    THS.runIO (FilePath -> IO FilePath
    readFile FilePath
    filePath)

    fileAndLine :: Loc -> String
    fileAndLine :: Loc -> FilePath
    fileAndLine Loc
    loc = Loc -> FilePath
    loc_filename Loc
    loc FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ":" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ (Int -> FilePath
    forall a. Show a => a -> FilePath
    show (Int -> FilePath) -> (Loc -> Int) -> Loc -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> Int
    forall a b. (a, b) -> a
    fst ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Loc -> (Int, Int)
    loc_start (Loc -> FilePath) -> Loc -> FilePath
    forall a b. (a -> b) -> a -> b
    $ Loc
    loc)

    compileTemplateTH :: String -> String -> Q Exp
    compileTemplateTH :: FilePath -> FilePath -> Q Exp
    compileTemplateTH FilePath
    filename FilePath
    unprocessed =
      (ParseError -> Q Exp)
    -> (Template -> Q Exp) -> Either ParseError Template -> Q Exp
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either
        (FilePath -> Q Exp
    forall a. FilePath -> Q a
    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
    fail (FilePath -> Q Exp)
    -> (ParseError -> FilePath) -> ParseError -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FilePath
    "Parse error in mustache template: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++) (FilePath -> FilePath)
    -> (ParseError -> FilePath) -> ParseError -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> FilePath
    forall a. Show a => a -> FilePath
    show)
        Template -> Q Exp
    forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
    forall (m :: * -> *). Quote m => Template -> m Exp
    THS.lift
        (FilePath -> Text -> Either ParseError Template
    compileTemplate FilePath
    filename (FilePath -> Text
    T.pack FilePath
    unprocessed))

    addDependentRelativeFile :: FilePath -> Q ()
    addDependentRelativeFile :: FilePath -> Q ()
    addDependentRelativeFile = FilePath -> Q ()
    forall (m :: * -> *). Quasi m => FilePath -> m ()
    THS.qAddDependentFile (FilePath -> Q ()) -> (FilePath -> Q FilePath) -> FilePath -> Q ()
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO FilePath -> Q FilePath
    forall a. IO a -> Q a
    THS.runIO (IO FilePath -> Q FilePath)
    -> (FilePath -> IO FilePath) -> FilePath -> Q FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> IO FilePath
    makeAbsolute

    -- ERRORS

    fileNotFound :: FilePath -> ParseError
    fileNotFound :: FilePath -> ParseError
    fileNotFound FilePath
    fp = Message -> SourcePos -> ParseError
    newErrorMessage
      (FilePath -> Message
    Message (FilePath -> Message) -> FilePath -> Message
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> FilePath
    forall r. PrintfType r => FilePath -> r
    printf FilePath
    "Template file '%s' not found" FilePath
    fp)
      (FilePath -> SourcePos
    initialPos FilePath
    fp)