{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      : Text.EDE
-- Copyright   : (c) 2013-2022 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- A (mostly) logic-less textual templating language with similar syntax to
-- <https://github.com/Shopify/liquid Liquid> or <http://jinja.pocoo.org/docs/ Jinja2>.
--
-- (ED-E is a character from Fallout New Vegas, pronounced 'Eddie'.)
module Text.EDE
  ( -- * How to use this library
    -- $usage

    -- * Parsing and Rendering
    -- $parsing_and_rendering
    Template,

    -- ** Parsing
    parse,
    parseIO,
    parseFile,
    parseFileWith,
    parseWith,

    -- ** Includes
    -- $resolvers
    Resolver,
    Id,
    includeMap,
    includeFile,

    -- ** Rendering
    render,
    renderWith,

    -- ** Either Variants
    eitherParse,
    eitherParseFile,
    eitherParseWith,
    eitherRender,
    eitherRenderWith,

    -- ** Results and Errors
    -- $results
    Trifecta.Delta.Delta (..),
    Result (..),
    eitherResult,
    result,
    success,
    failure,

    -- * Input
    -- $input
    fromValue,
    fromPairs,
    (.=),

    -- * Version
    version,

    -- * Syntax
    Delim,
    Syntax,
    delimPragma,
    delimInline,
    delimComment,
    delimBlock,
    defaultSyntax,
    alternateSyntax,

    -- ** Pragmas
    -- $pragmas

    -- ** Expressions
    -- $expressions

    -- ** Variables
    -- $variables

    -- ** Conditionals
    -- $conditionals

    -- ** Case Analysis
    -- $case

    -- ** Loops
    -- $loops

    -- ** Includes
    -- $includes

    -- ** Filters
    -- $filters

    -- ** Raw
    -- $raw

    -- ** Comments
    -- $comments

    -- ** Let Expressions
    -- $let

    -- ** Set
    -- $set
  )
where

import qualified Control.Monad as Monad
import Data.Aeson ((.=))
import Data.Aeson.Types (Value)
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.Foldable as Foldable
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Builder
import Data.Version (Version)
import qualified Paths_ede as Paths
import Prettyprinter (Pretty (..))
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import qualified Text.EDE.Internal.Eval as Eval
import qualified Text.EDE.Internal.Parser as Parser
import Text.EDE.Internal.Quoting (Term)
import Text.EDE.Internal.Syntax
import Text.EDE.Internal.Types
import qualified Text.Trifecta.Delta as Trifecta.Delta

-- | ED-E Version.
version :: Version
version :: Version
version = Version
Paths.version

-- | Parse a 'ByteString' into a compiled 'Template'.
--
-- Because this function is pure and does not resolve @include@s,
-- encountering an @include@ expression during parsing will result in an 'Error'.
--
-- See 'parseFile' or 'parseWith' for mechanisms to deal with @include@
-- dependencies.
parse ::
  -- | Strict 'ByteString' template definition.
  ByteString ->
  Result Template
parse :: ByteString -> Result Template
parse = Result (Result Template) -> Result Template
forall (m :: * -> *) a. Monad m => m (m a) -> m a
Monad.join (Result (Result Template) -> Result Template)
-> (ByteString -> Result (Result Template))
-> ByteString
-> Result Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Syntax
-> Resolver Result -> Id -> ByteString -> Result (Result Template)
forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
defaultSyntax (HashMap Id Template -> Resolver Result
forall (m :: * -> *). Monad m => HashMap Id Template -> Resolver m
includeMap HashMap Id Template
forall a. Monoid a => a
mempty) Id
"Text.EDE.parse"

-- | Parse a 'ByteString' into a compiled 'Template'.
--
-- This function handles all @include@ expressions as 'FilePath's and performs
-- recursive loading/parsing.
parseIO ::
  -- | Parent directory for relatively pathed includes.
  FilePath ->
  -- | Strict 'ByteString' template definition.
  ByteString ->
  IO (Result Template)
parseIO :: FilePath -> ByteString -> IO (Result Template)
parseIO FilePath
p = Syntax -> Resolver IO -> Id -> ByteString -> IO (Result Template)
forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
defaultSyntax (FilePath -> Resolver IO
includeFile FilePath
p) Id
"Text.EDE.parse"

-- | Load and parse a 'Template' from a file.
--
-- This function handles all @include@ expressions as 'FilePath's and performs
-- recursive loading/parsing, with pathing of @include@s relatively to the
-- target (unless absolute paths are used).
parseFile ::
  -- | Path to the template to load and parse.
  FilePath ->
  IO (Result Template)
parseFile :: FilePath -> IO (Result Template)
parseFile = Syntax -> FilePath -> IO (Result Template)
parseFileWith Syntax
defaultSyntax

-- | /See:/ 'parseFile'.
parseFileWith ::
  -- | Delimiters and parsing options.
  Syntax ->
  -- | Path to the template to load and parse.
  FilePath ->
  IO (Result Template)
parseFileWith :: Syntax -> FilePath -> IO (Result Template)
parseFileWith Syntax
s FilePath
p =
  FilePath -> IO (Result ByteString)
loadFile FilePath
p
    IO (Result ByteString)
-> (Result ByteString -> IO (Result Template))
-> IO (Result Template)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnsiDoc -> IO (Result Template))
-> (ByteString -> IO (Result Template))
-> Result ByteString
-> IO (Result Template)
forall b a. (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result
      AnsiDoc -> IO (Result Template)
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure
      (Syntax -> Resolver IO -> Id -> ByteString -> IO (Result Template)
forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
s (FilePath -> Resolver IO
includeFile (FilePath -> FilePath
FilePath.takeDirectory FilePath
p)) (FilePath -> Id
Text.pack FilePath
p))

-- | Parse a 'Template' from a Strict 'ByteString' using a custom function for
-- resolving @include@ expressions.
--
-- Two custom @include@ resolvers are supplied:
--
-- * 'includeMap'
--
-- * 'includeFile'
--
-- 'parseFile' for example, is defined as: 'parseWith' 'includeFile'.
parseWith ::
  Monad m =>
  -- | Delimiters and parsing options.
  Syntax ->
  -- | Function to resolve includes.
  Resolver m ->
  -- | Strict 'Text' name.
  Text ->
  -- | Strict 'ByteString' template definition.
  ByteString ->
  m (Result Template)
parseWith :: forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
config Resolver m
f Id
name ByteString
input =
  case Syntax
-> Id
-> ByteString
-> Result
     (Exp Delta, HashMap Id (NonEmpty Delta),
      HashMap Id (NonEmpty Delta), HashMap Id (Exp Delta))
Parser.runParser Syntax
config Id
name ByteString
input of
    Success (Exp Delta
u, HashMap Id (NonEmpty Delta)
is', HashMap Id (NonEmpty Delta)
es', HashMap Id (Exp Delta)
bs) -> do
      Result (HashMap Id (Exp Delta))
is <- ((Id, NonEmpty Delta)
 -> Result (HashMap Id (Exp Delta))
 -> m (Result (HashMap Id (Exp Delta))))
-> Result (HashMap Id (Exp Delta))
-> [(Id, NonEmpty Delta)]
-> m (Result (HashMap Id (Exp Delta)))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Foldable.foldrM (Id, NonEmpty Delta)
-> Result (HashMap Id (Exp Delta))
-> m (Result (HashMap Id (Exp Delta)))
include (HashMap Id (Exp Delta) -> Result (HashMap Id (Exp Delta))
forall a. a -> Result a
Success (Id -> Exp Delta -> HashMap Id (Exp Delta)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Id
name Exp Delta
u)) (HashMap Id (NonEmpty Delta) -> [(Id, NonEmpty Delta)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Id (NonEmpty Delta)
is')
      Result (HashMap Id (Exp Delta))
es <- ((Id, NonEmpty Delta)
 -> Result (HashMap Id (Exp Delta))
 -> m (Result (HashMap Id (Exp Delta))))
-> Result (HashMap Id (Exp Delta))
-> [(Id, NonEmpty Delta)]
-> m (Result (HashMap Id (Exp Delta)))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Foldable.foldrM (Id, NonEmpty Delta)
-> Result (HashMap Id (Exp Delta))
-> m (Result (HashMap Id (Exp Delta)))
extends (HashMap Id (Exp Delta) -> Result (HashMap Id (Exp Delta))
forall a. a -> Result a
Success HashMap Id (Exp Delta)
forall a. Monoid a => a
mempty) (HashMap Id (NonEmpty Delta) -> [(Id, NonEmpty Delta)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Id (NonEmpty Delta)
es')
      Result Template -> m (Result Template)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Id
-> Exp Delta
-> HashMap Id (Exp Delta)
-> HashMap Id (Exp Delta)
-> HashMap Id (Exp Delta)
-> Template
Template Id
name Exp Delta
u (HashMap Id (Exp Delta)
 -> HashMap Id (Exp Delta) -> HashMap Id (Exp Delta) -> Template)
-> Result (HashMap Id (Exp Delta))
-> Result
     (HashMap Id (Exp Delta) -> HashMap Id (Exp Delta) -> Template)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (HashMap Id (Exp Delta))
is Result
  (HashMap Id (Exp Delta) -> HashMap Id (Exp Delta) -> Template)
-> Result (HashMap Id (Exp Delta))
-> Result (HashMap Id (Exp Delta) -> Template)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Result (HashMap Id (Exp Delta))
es Result (HashMap Id (Exp Delta) -> Template)
-> Result (HashMap Id (Exp Delta)) -> Result Template
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Id (Exp Delta) -> Result (HashMap Id (Exp Delta))
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashMap Id (Exp Delta)
bs)
    Failure AnsiDoc
err ->
      AnsiDoc -> m (Result Template)
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure AnsiDoc
err
  where
    -- Presuming self is always in self's includes, see singleton above.
    -- FIXME: utilise the list of deltas for failures
    include :: (Id, NonEmpty Delta)
-> Result (HashMap Id (Exp Delta))
-> m (Result (HashMap Id (Exp Delta)))
include (Id
_, NonEmpty Delta
_) (Failure AnsiDoc
err) = AnsiDoc -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure AnsiDoc
err
    include (Id
key, Delta
delta :| [Delta]
_) (Success HashMap Id (Exp Delta)
ss) =
      Resolver m
f Syntax
config Id
key Delta
delta
        m (Result Template)
-> (Result Template -> m (Result (HashMap Id (Exp Delta))))
-> m (Result (HashMap Id (Exp Delta)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnsiDoc -> m (Result (HashMap Id (Exp Delta))))
-> (Template -> m (Result (HashMap Id (Exp Delta))))
-> Result Template
-> m (Result (HashMap Id (Exp Delta)))
forall b a. (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result AnsiDoc -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure (HashMap Id (Exp Delta) -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => a -> m (Result a)
success (HashMap Id (Exp Delta) -> m (Result (HashMap Id (Exp Delta))))
-> (Template -> HashMap Id (Exp Delta))
-> Template
-> m (Result (HashMap Id (Exp Delta)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Id (Exp Delta)
-> HashMap Id (Exp Delta) -> HashMap Id (Exp Delta)
forall a. Monoid a => a -> a -> a
mappend HashMap Id (Exp Delta)
ss (HashMap Id (Exp Delta) -> HashMap Id (Exp Delta))
-> (Template -> HashMap Id (Exp Delta))
-> Template
-> HashMap Id (Exp Delta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> HashMap Id (Exp Delta)
_tmplIncl)

    extends :: (Id, NonEmpty Delta)
-> Result (HashMap Id (Exp Delta))
-> m (Result (HashMap Id (Exp Delta)))
extends (Id
_, NonEmpty Delta
_) (Failure AnsiDoc
err) = AnsiDoc -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure AnsiDoc
err
    extends (Id
key, Delta
delta :| [Delta]
_) (Success HashMap Id (Exp Delta)
ss) =
      Resolver m
f Syntax
config Id
key Delta
delta
        m (Result Template)
-> (Result Template -> m (Result (HashMap Id (Exp Delta))))
-> m (Result (HashMap Id (Exp Delta)))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnsiDoc -> m (Result (HashMap Id (Exp Delta))))
-> (Template -> m (Result (HashMap Id (Exp Delta))))
-> Result Template
-> m (Result (HashMap Id (Exp Delta)))
forall b a. (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result AnsiDoc -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure (HashMap Id (Exp Delta) -> m (Result (HashMap Id (Exp Delta)))
forall (m :: * -> *) a. Monad m => a -> m (Result a)
success (HashMap Id (Exp Delta) -> m (Result (HashMap Id (Exp Delta))))
-> (Template -> HashMap Id (Exp Delta))
-> Template
-> m (Result (HashMap Id (Exp Delta)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Id (Exp Delta)
-> HashMap Id (Exp Delta) -> HashMap Id (Exp Delta)
forall a. Monoid a => a -> a -> a
mappend HashMap Id (Exp Delta)
ss (HashMap Id (Exp Delta) -> HashMap Id (Exp Delta))
-> (Template -> HashMap Id (Exp Delta))
-> Template
-> HashMap Id (Exp Delta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> HashMap Id (Exp Delta)
_tmplIncl)

-- | 'HashMap' resolver for @include@ expressions.
--
-- The 'identifier' component of the @include@ expression is treated as a lookup
-- key into the supplied 'HashMap'.
-- If the 'identifier' doesn't exist in the 'HashMap', an 'Error' is returned.
includeMap ::
  Monad m =>
  -- | A 'HashMap' of named 'Template's.
  HashMap Id Template ->
  -- | Resolver for 'parseWith'.
  Resolver m
includeMap :: forall (m :: * -> *). Monad m => HashMap Id Template -> Resolver m
includeMap HashMap Id Template
templates Syntax
_config Id
key Delta
_delta
  | Just Template
val <- Id -> HashMap Id Template -> Maybe Template
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Id
key HashMap Id Template
templates = Template -> m (Result Template)
forall (m :: * -> *) a. Monad m => a -> m (Result a)
success Template
val
  | Bool
otherwise = AnsiDoc -> m (Result Template)
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure (AnsiDoc
"unable to resolve " AnsiDoc -> AnsiDoc -> AnsiDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> AnsiDoc
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Id -> FilePath
Text.unpack Id
key))

-- FIXME: utilise deltas in error messages

-- | 'FilePath' resolver for @include@ expressions.
--
-- The 'identifier' component of the @include@ expression is treated as a relative
-- 'FilePath' and the template is loaded and parsed using 'parseFile'.
-- If the 'identifier' doesn't exist as a valid 'FilePath', an 'Error' is returned.
includeFile ::
  -- | Parent directory for relatively pathed includes.
  FilePath ->
  Resolver IO
includeFile :: FilePath -> Resolver IO
includeFile FilePath
path Syntax
config Id
key Delta
_delta =
  FilePath -> IO (Result ByteString)
loadFile FilePath
file IO (Result ByteString)
-> (Result ByteString -> IO (Result Template))
-> IO (Result Template)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnsiDoc -> IO (Result Template))
-> (ByteString -> IO (Result Template))
-> Result ByteString
-> IO (Result Template)
forall b a. (AnsiDoc -> b) -> (a -> b) -> Result a -> b
result AnsiDoc -> IO (Result Template)
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure (Syntax -> Resolver IO -> Id -> ByteString -> IO (Result Template)
forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
config Resolver IO
include Id
key)
  where
    include :: Resolver IO
    include :: Resolver IO
include = FilePath -> Resolver IO
includeFile (FilePath -> FilePath
FilePath.takeDirectory FilePath
file)

    file :: FilePath
file
      | Id -> Bool
Text.null Id
key = Id -> FilePath
Text.unpack Id
key
      | Bool
otherwise = FilePath -> FilePath -> FilePath
FilePath.combine FilePath
path (Id -> FilePath
Text.unpack Id
key)

loadFile :: FilePath -> IO (Result ByteString)
loadFile :: FilePath -> IO (Result ByteString)
loadFile FilePath
path = do
  Bool
exists <- FilePath -> IO Bool
Directory.doesFileExist FilePath
path

  if Bool -> Bool
not Bool
exists
    then AnsiDoc -> IO (Result ByteString)
forall (m :: * -> *) a. Monad m => AnsiDoc -> m (Result a)
failure (AnsiDoc
"file " AnsiDoc -> AnsiDoc -> AnsiDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> AnsiDoc
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
path AnsiDoc -> AnsiDoc -> AnsiDoc
forall a. Semigroup a => a -> a -> a
<> AnsiDoc
" doesn't exist.")
    else FilePath -> IO ByteString
ByteString.readFile FilePath
path IO ByteString
-> (ByteString -> IO (Result ByteString)) -> IO (Result ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO (Result ByteString)
forall (m :: * -> *) a. Monad m => a -> m (Result a)
success

-- | Render an 'HashMap Text Value' using the supplied 'Template'.
render ::
  -- | Parsed 'Template' to render.
  Template ->
  -- | Bindings to make available in the environment.
  HashMap Text Value ->
  Result Text.Lazy.Text
render :: Template -> HashMap Id Value -> Result Text
render = HashMap Id Term -> Template -> HashMap Id Value -> Result Text
renderWith HashMap Id Term
forall a. Monoid a => a
mempty

-- | Render an 'HashMap Text Value' using the supplied 'Template'.
renderWith ::
  -- | Filters to make available in the environment.
  HashMap Id Term ->
  -- | Parsed 'Template' to render.
  Template ->
  -- | Bindings to make available in the environment.
  HashMap Text Value ->
  Result Text.Lazy.Text
renderWith :: HashMap Id Term -> Template -> HashMap Id Value -> Result Text
renderWith HashMap Id Term
fs Template
t =
  (Builder -> Text) -> Result Builder -> Result Text
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Builder -> Text
Text.Builder.toLazyText (Result Builder -> Result Text)
-> (HashMap Id Value -> Result Builder)
-> HashMap Id Value
-> Result Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    HashMap Id (Exp Delta)
-> HashMap Id Term
-> Exp Delta
-> HashMap Id Value
-> Result Builder
Eval.render
      (Template -> HashMap Id (Exp Delta)
_tmplIncl Template
t HashMap Id (Exp Delta)
-> HashMap Id (Exp Delta) -> HashMap Id (Exp Delta)
forall a. Semigroup a => a -> a -> a
<> Template -> HashMap Id (Exp Delta)
_tmplExtends Template
t)
      HashMap Id Term
fs
      (Template -> Exp Delta
_tmplExp Template
t)

-- | /See:/ 'parse'
eitherParse :: ByteString -> Either String Template
eitherParse :: ByteString -> Either FilePath Template
eitherParse = Result Template -> Either FilePath Template
forall a. Result a -> Either FilePath a
eitherResult (Result Template -> Either FilePath Template)
-> (ByteString -> Result Template)
-> ByteString
-> Either FilePath Template
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Result Template
parse

-- | /See:/ 'parseFile'
eitherParseFile :: FilePath -> IO (Either String Template)
eitherParseFile :: FilePath -> IO (Either FilePath Template)
eitherParseFile = (Result Template -> Either FilePath Template)
-> IO (Result Template) -> IO (Either FilePath Template)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result Template -> Either FilePath Template
forall a. Result a -> Either FilePath a
eitherResult (IO (Result Template) -> IO (Either FilePath Template))
-> (FilePath -> IO (Result Template))
-> FilePath
-> IO (Either FilePath Template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Result Template)
parseFile

-- | /See:/ 'parseWith'
eitherParseWith ::
  (Functor m, Monad m) =>
  Syntax ->
  Resolver m ->
  Text ->
  ByteString ->
  m (Either String Template)
eitherParseWith :: forall (m :: * -> *).
(Functor m, Monad m) =>
Syntax
-> Resolver m -> Id -> ByteString -> m (Either FilePath Template)
eitherParseWith Syntax
o Resolver m
f Id
n = (Result Template -> Either FilePath Template)
-> m (Result Template) -> m (Either FilePath Template)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Result Template -> Either FilePath Template
forall a. Result a -> Either FilePath a
eitherResult (m (Result Template) -> m (Either FilePath Template))
-> (ByteString -> m (Result Template))
-> ByteString
-> m (Either FilePath Template)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
forall (m :: * -> *).
Monad m =>
Syntax -> Resolver m -> Id -> ByteString -> m (Result Template)
parseWith Syntax
o Resolver m
f Id
n

-- | /See:/ 'render'
eitherRender ::
  Template ->
  HashMap Text Value ->
  Either String Text.Lazy.Text
eitherRender :: Template -> HashMap Id Value -> Either FilePath Text
eitherRender Template
t = Result Text -> Either FilePath Text
forall a. Result a -> Either FilePath a
eitherResult (Result Text -> Either FilePath Text)
-> (HashMap Id Value -> Result Text)
-> HashMap Id Value
-> Either FilePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Template -> HashMap Id Value -> Result Text
render Template
t

-- | /See:/ 'renderWith'
eitherRenderWith ::
  HashMap Id Term ->
  Template ->
  HashMap Text Value ->
  Either String Text.Lazy.Text
eitherRenderWith :: HashMap Id Term
-> Template -> HashMap Id Value -> Either FilePath Text
eitherRenderWith HashMap Id Term
fs Template
t = Result Text -> Either FilePath Text
forall a. Result a -> Either FilePath a
eitherResult (Result Text -> Either FilePath Text)
-> (HashMap Id Value -> Result Text)
-> HashMap Id Value
-> Either FilePath Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Id Term -> Template -> HashMap Id Value -> Result Text
renderWith HashMap Id Term
fs Template
t

-- $usage
--
-- A simple example of parsing and rendering 'Text' containing a basic conditional
-- expression and variable interpolation follows.
--
-- First the 'Template' is defined and parsed in the 'Result' monad:
--
-- >>> tmpl <- parse "{% if var %}\nHello, {{ var }}!\n{% else %}\nnegative!\n{% endif %}\n" :: Result Template
--
-- Then an 'HashMap Text Value' is defined containing the environment which will be
-- available to the 'Template' during rendering:
--
-- >>> let env = fromPairs [ "var" .= "World" ] :: HashMap Text Value
--
-- Note: the 'fromPairs' function above is a wrapper over Aeson's 'object'
-- which removes the outer 'Data.Aeson.Object' 'Value' constructor, exposing the underlying 'HashMap'.
--
-- Then, the 'Template' is rendered using the 'HashMap Text Value' environment:
--
-- >>> render tmpl env :: Result Text
-- > Success "Hello, World!"
--
-- In this manner, 'Template's can be pre-compiled to the internal AST and
-- the cost of parsing can be amortised if the same 'Template' is rendered multiple times.
--
-- Another example, this time rendering a 'Template' from a file:
--
-- > import qualified Data.Text.Lazy as Text.Lazy
-- > import qualified           Text.EDE as EDE
-- >
-- > main :: IO ()
-- > main = do
-- >     r <- eitherParseFile "template.ede"
-- >     either error print $ r >>= (`eitherRender` env)
-- >   where
-- >     env = fromPairs
-- >         [ "text" .= "Some Text."
-- >         , "int"  .= 1
-- >         , "list" .= [5..10]
-- >         ]
--
-- Please see the syntax section for more information about available
-- statements and expressions.

-- $parsing_and_rendering
--
-- Parsing and rendering require two separate steps intentionally so that the
-- more expensive (and potentially impure) action of parsing and resolving
-- @include@s can be embedded and re-used in a pure fashion.
--
-- * Parsing tokenises the input and converts it to an internal AST representation,
-- resolving @include@s using a custom function. The result is a compiled template
-- which can be cached for future use.
--
-- * Rendering takes a 'HashMap' of custom 'Fun's (functions available in the
-- template context), an 'HashMap Text Value' as the binding environment, and a parsed
-- 'Template' to subsitute the values into.
-- The result is a Lazy 'Text.Lazy.Text' value containing the rendered output.

-- $resolvers
--
-- The 'Resolver' used to resolve @include@ expressions determines the purity
-- of 'Template' parsing.
--
-- For example, using the 'includeFile' 'Resolver' means parsing is restricted
-- to 'IO', while pre-caching a 'HashMap' of 'Template's and supplying them to
-- 'parseWith' using 'includeMap' offers a pure variant for @include@ resolution.

-- $results
--
-- The 'Result' of a 'parse' or 'render' steps can be inspected or analysed using
-- 'result' as follows:
--
-- >>> result failure success $ render tmpl env
--
-- If you're only interested in dealing with errors as strings, and the positional
-- information contained in 'Meta' is not of use you can use the convenience functions
-- 'eitherParse', 'eitherRender', or convert a 'Result' to 'Either' using 'eitherResult'.
--
-- >>> either failure success $ eitherParse tmpl

-- $input
--
-- 'fromPairs' (or 'fromValue') is a wrapper around Aeson's 'object' function which
--  safely strips the outer 'Value' constructor, providing the correct type
-- signature for input into 'render'.
--
-- It is used in combination with the re-exported '.=' as follows:
--
-- >>> render (fromPairs [ "foo" .= "value", "bar" .= 1 ]) :: Template -> Result Text

-- #syntax#
--

-- $pragmas
--
-- Syntax can be modified either via the arguments to 'parseWith' or alternatively
-- by specifying the delimiters via an @EDE_SYNTAX@ pragma.
--
-- /Note:/ The pragmas must start on line1. Subsequently encountered
-- pragmas are parsed as textual template contents.
--
-- For example:
--
-- > {! EDE_SYNTAX pragma=("{*", "*}") inline=("#@", "@#") comment=("<#", "#>") block=("$$", "$$") !}
-- > {* EDE_SYNTAX block=("#[", "]#")  *}
-- > ...
--
-- Would result in the following syntax:
--
-- * Pragmas: @{* ... *}@
--
-- * Inline: @\#\@ ... \@\#@
--
-- * Comment: @\<\# ... \#>@
--
-- * Block: @\#[ ... ]\#@
--
-- /Note:/ @EDE_SYNTAX@ pragmas only take effect for the current template, not
-- child includes. If you want to override the syntax for all templates use 'parseWith'
-- and custom 'Syntax' settings.

-- $expressions
--
-- Expressions behave as any simplistic programming language with a variety of
-- prefix, infix, and postifx operators available. (/See:/ "Text.EDE.Filters")
--
-- A rough overview of the expression grammar:
--
-- > expression ::= literal | identifier | '|' filter
-- > filter     ::= identifier
-- > identifier ::= [a-zA-Z_]{1}[0-9A-Za-z_']*
-- > object     ::= '{' pairs '}'
-- > pairs      ::= string ':' literal | string ':' literal ',' pairs
-- > array      ::= '[' elements ']'
-- > elements   ::= literal | literal ',' elements
-- > literal    ::= object | array | boolean | number | string
-- > boolean    ::= true | false
-- > number     ::= integer | double
-- > string     ::= "char+|escape"

--
-- /Note:/
--

-- * Identifiers are named similarly to Haskell's rules.

--

-- * Booleans are lowered cased.

--

-- * The string quoting and escaping follows Haskell's rules.

--

-- * The Numeric format shares the same characteristics as the <http://json.org/ JSON specification.>

-- $variables
--
-- Variables are substituted directly for their renderable representation.
-- An error is raised if the varaible being substituted is not a literal type
-- (ie. an 'Array' or 'HashMap Text Value') or doesn't exist in the supplied environment.
--
-- > {{ var }}
--
-- Nested variable access is also supported for variables which resolve to an 'HashMap Text Value'.
-- Dot delimiters are used to chain access through multiple nested 'HashMap Text Value's.
-- The right-most accessor must resolve to a renderable type as with the previous
-- non-nested variable access.
--
-- > {{ nested.var.access }}

-- $conditionals
--
-- A conditional is introduced and completed with the section syntax:
--
-- > {% if <expr1> %}
-- >    ... consequent expressions
-- > {% elif <expr2> %}
-- >    ... consequent expressions
-- > {% elif <expr3> %}
-- >    ... consequent expressions
-- > {% else %}
-- >    ... alternate expressions
-- > {% endif %}
--
-- The boolean result of the @expr@ determines the branch that is rendered by
-- the template with multiple (or none) elif branches supported, and the
-- else branch being optional.
--
-- In the case of a literal it conforms directly to the supported boolean or relation logical
-- operators from Haskell.
-- If a variable is singularly used its existence determines the result of the predicate;
-- the exception to this rule is boolean values which will be substituted into the
-- expression if they exist in the supplied environment.
--
-- The following logical expressions are supported as predicates in conditional statements
-- with parameters type checked and an error raised if the left and right
-- hand sides are not type equivalent.
--
-- * @And@: '&&'
--
-- * @Or@: '||'
--
-- * @Equal@: '=='
--
-- * @Not Equal@: @!=@ (/See:/ '/=')
--
-- * @Greater@: '>'
--
-- * @Greater Or Equal@: '>='
--
-- * @Less@: '<'
--
-- * @Less Or Equal@: '<='
--
-- * @Negation@: @!@ (/See:/ 'not')
--
-- /See:/ "Text.EDE.Filters"

-- $case
--
-- To pattern match a literal or variable, you can use the @case@ statement:
--
-- > {% case var %}
-- > {% when "a" %}
-- >    .. matched expressions
-- > {% when "b" %}
-- >    .. matched expressions
-- > {% else %}
-- >    .. alternate expressions
-- > {% endcase %}
--
-- Patterns take the form of @variables@, @literals@, or the wild-card
-- '@_@' pattern (which matches anything).

-- $loops
--
-- Iterating over an 'Array' or 'HashMap Text Value' can be acheived using the 'for ... in' section syntax.
-- Attempting to iterate over any other type will raise an error.
--
-- Example:
--
-- > {% for var in list %}
-- >     ... iteration expression
-- > {% else %}
-- >     ... alternate expression
-- > {% endfor %}
--
-- The iteration branch is rendering per item with the else branch being (which is optional)
-- being rendered if the @{{ list }}@ variable is empty.
--
-- When iterating over an 'HashMap Text Value', a stable sort using key equivalence is applied, 'Array's
-- are unmodified.
--
-- The resulting binding within the iteration expression (in this case, @{{ var }}@) is
-- an 'HashMap Text Value' containing the following keys:
--
-- * @key        :: Text@: They key if the loop target is an 'HashMap Text Value'
--
-- * @value      :: a@: The value of the loop target
--
-- * @loop       :: Object@: Loop metadata.
--
-- * @length     :: Int@: Length of the loop
--
-- * @index      :: Int@: Index of the iteration
--
-- * @index0     :: Int@: Zero based index of the iteration
--
-- * @remainder  :: Int@: Remaining number of iterations
--
-- * @remainder0 :: Int@: Zero based remaining number of iterations
--
-- * @first      :: Bool@: Is this the first iteration?
--
-- * @last       :: Bool@: Is this the last iteration?
--
-- * @odd        :: Bool@: Is this an odd iteration?
--
-- * @even       :: Bool@: Is this an even iteration?
--
-- For example:
--
-- > {% for item in items %}
-- >     {{ item.index }}:{{ item.value }}
-- >     {% if !item.last %}
-- >
-- >     {% endif %}
-- > {% endfor %}
--
-- Will render each item with its (1-based) loop index as a prefix, separated
-- by a blank newline, without a trailing at the end of the document.
--
-- Valid loop targets are 'HashMap Text Value's, 'Array's, and 'String's, with
-- only 'HashMap Text Value's having an available @{{ <var>.key }}@ in scope.

-- $includes
--
-- Includes are a way to reduce the amount of noise in large templates.
-- They can be used to abstract out common snippets and idioms into partials.
--
-- If 'parseFile' or the 'includeFile' resolver is used, templates will be loaded
-- using 'FilePath's. (This is the default.)
--
-- For example:
--
-- > {% include "/var/tmp/partial.ede" %}
--
-- Loads @partial.ede@ from the file system.
--
-- The current environment is made directly available to the included template.
-- Additional bindings can be created (/See:/ @let@) which will be additionally
-- available only within the include under a specific identifier:
--
-- > {% include "/var/tmp/partial.ede" with some_number = 123 %}
--
-- Includes can also be resolved using pure 'Resolver's such as 'includeMap',
-- which will treat the @include@ expression's identifier as a 'HashMap' key:
--
-- > {% include "arbitrary_key" %}
--
-- Uses 'Map.lookup' to find @arbitrary_key@ in the 'HashMap' supplied to 'includeMap'.

-- $filters
--
-- Filters are typed functions which can be applied to variables and literals.
-- An example of rendering a lower cased boolean would be:
--
-- > {{ true | show | lower }}
--
-- The input is on the LHS and chained filters (delimited by the pipe operator @|@)
-- are on the RHS, with filters being applied postfix, left associatively.
--
-- /See:/ "Text.EDE.Filters"

-- $raw
--
-- You can disable template processing for blocks of text using the @raw@ section:
--
-- > {% raw %}
-- > Some {{{ handlebars }}} or {{ mustache }} or {{ jinja2 }} output tags etc.
-- > {% endraw %}
--
-- This can be used to avoid parsing expressions which would otherwise be
-- considered valid @ED-E@ syntax.

-- $comments
--
-- Comments are ignored by the parser and omitted from the rendered output.
--
-- > {# singleline comment #}
--
-- > {#
-- >    multiline
-- >    comment
-- > #}

-- $let
--
-- You can also bind an identifier to values which will be available within
-- the following expression scope.
--
-- For example:
--
-- > {% let var = false %}
-- > ...
-- > {{ var }}
-- > ...
-- > {% endlet %}

-- $set
--
-- You can also bind an identifier to whole templates which will be available within
-- the following expression scope. The identifier will be available in subsequent template.
--
-- For example:
--
-- > {% set var %}
-- >   ...
-- > {% endset %}
-- > ...
-- > {{ var }}

-- $block
--
-- Blocks are used for inheritance and act as both placeholders and replacements at the same time: The most powerful
-- part of @ED-E@ is template inheritance. Template inheritance allows you to build a base "skeleton" template that
-- contains all the common elements of your site and defines blocks that child templates can override.
--
-- Base template:
--
-- > <!doctype html>
-- > {% block head %}
-- > <title>{% block title %}{% endblock %}</title>
-- > {% endblock %}
-- > {% block body %}{% endblock %}
--
-- Child template:
--
-- > {% extends "base.html" %}
-- > {% block title %}Index{% endblock %}
-- > {% block head %}
-- >  {{ super }}
-- >  <style type="text/css">
-- >   .important { color: #336699; }
-- > </style>
-- > {% endblock %}
-- > {% block body %}
-- >  <h1>Index</h1>
-- >  <p class="important">
-- >    Welcome to my awesome homepage.
-- >  </p>
-- > {% endblock %}
--
-- The @{% extends %}@ tag is the key here. It tells the template engine that this template "extends" another template.
-- When the template system evaluates this template, it first locates the parent. The extends tag should be the first tag in the template.
--
-- As you can see it's also possible to render the contents of the parent block by calling super(). You can’t define multiple {% block %}
-- tags with the same name in the same template. This limitation exists because a block tag works in “both” directions. That is, a block
-- tag doesn’t just provide a placeholder to fill - it also defines the content that fills the placeholder in the parent. If there were two
-- similarly-named {% block %} tags in a template, that template's parent wouldn’t know which one of the blocks’ content to use.