-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A mustache template parser library. -- -- Allows parsing and rendering template files with mustache markup. See -- the mustache language reference. -- -- Implements the mustache spec version 1.1.3. -- -- Note: Versions including and beyond 0.4 are compatible with ghc -- 7.8 again. @package mustache @version 2.1.2 module Text.Mustache.Types type ASTree α = [Node α] -- | Syntax tree for a mustache template type STree = ASTree Text -- | Basic values composing the STree data Node α TextBlock :: α -> Node α Section :: DataIdentifier -> (ASTree α) -> Node α InvertedSection :: DataIdentifier -> (ASTree α) -> Node α Variable :: Bool -> DataIdentifier -> Node α Partial :: (Maybe α) -> FilePath -> Node α -- | Kinds of identifiers for Variables and sections data DataIdentifier NamedData :: [Key] -> DataIdentifier Implicit :: DataIdentifier -- | A compiled Template with metadata. data Template Template :: String -> STree -> TemplateCache -> Template [name] :: Template -> String [ast] :: Template -> STree [partials] :: Template -> TemplateCache -- | A collection of templates with quick access via their hashed names type TemplateCache = HashMap String Template -- | Internal value representation data Value Object :: !Object -> Value Array :: !Array -> Value Number :: !Scientific -> Value String :: !Text -> Value Lambda :: (Context Value -> STree -> STree) -> Value Bool :: !Bool -> Value Null :: Value -- | Type of key used for retrieving data from Values type Key = Text -- | Convenience function for creating Object values. -- -- This function is supposed to be used in conjuction with the -- ~> and ~= operators. -- --
-- data Address = Address { ... }
--
-- instance Address ToJSON where
-- ...
--
-- data Person = Person { name :: String, address :: Address }
--
-- instance ToMustache Person where
-- toMustache (Person { name, address }) = object
-- [ "name" ~> name
-- , "address" ~= address
-- ]
--
--
-- Here we can see that we can use the ~> operator for values
-- that have themselves a ToMustache instance, or alternatively if
-- they lack such an instance but provide an instance for the
-- ToJSON typeclass we can use the ~= operator.
object :: [Pair] -> Value
-- | Map keys to values that provide a ToMustache instance
--
-- Recommended in conjunction with the OverloadedStrings
-- extension.
(~>) :: ToMustache ω => Text -> ω -> Pair
infixr 8 ~>
-- | Unicode version of ~>
(↝) :: ToMustache ω => Text -> ω -> Pair
infixr 8 ↝
-- | Map keys to values that provide a ToJSON instance
--
-- Recommended in conjunction with the OverloadedStrings
-- extension.
(~=) :: ToJSON ι => Text -> ι -> Pair
infixr 8 ~=
-- | Unicode version of ~=
(⥱) :: ToJSON ι => Text -> ι -> Pair
infixr 8 ⥱
-- | Conversion class
class ToMustache ω where listToMustache = listToMustache'
toMustache :: ToMustache ω => ω -> Value
toMustache :: ToMustache ω => ω -> Value
-- | Converts a value that can be represented as JSON to a Value.
mFromJSON :: ToJSON ι => ι -> Value
-- | A list-like structure used in Value
type Array = Vector Value
-- | A map-like structure used in Value
type Object = HashMap Text Value
-- | Source type for constructing Objects
type Pair = (Text, Value)
-- | Representation of stateful context for the substitution process
data Context α
Context :: [α] -> α -> Context α
instance Language.Haskell.TH.Syntax.Lift Text.Mustache.Types.Template
instance Language.Haskell.TH.Syntax.Lift α0 => Language.Haskell.TH.Syntax.Lift (Text.Mustache.Types.Node α0)
instance Language.Haskell.TH.Syntax.Lift Text.Mustache.Types.DataIdentifier
instance GHC.Show.Show Text.Mustache.Types.Template
instance GHC.Classes.Eq α => GHC.Classes.Eq (Text.Mustache.Types.Node α)
instance GHC.Show.Show α => GHC.Show.Show (Text.Mustache.Types.Node α)
instance GHC.Classes.Eq Text.Mustache.Types.DataIdentifier
instance GHC.Show.Show Text.Mustache.Types.DataIdentifier
instance GHC.Classes.Ord α => GHC.Classes.Ord (Text.Mustache.Types.Context α)
instance GHC.Show.Show α => GHC.Show.Show (Text.Mustache.Types.Context α)
instance GHC.Classes.Eq α => GHC.Classes.Eq (Text.Mustache.Types.Context α)
instance GHC.Show.Show Text.Mustache.Types.Value
instance Text.Mustache.Types.ToMustache GHC.Types.Float
instance Text.Mustache.Types.ToMustache GHC.Types.Double
instance Text.Mustache.Types.ToMustache GHC.Integer.Type.Integer
instance Text.Mustache.Types.ToMustache GHC.Types.Int
instance Text.Mustache.Types.ToMustache GHC.Types.Char
instance Text.Mustache.Types.ToMustache Text.Mustache.Types.Value
instance Text.Mustache.Types.ToMustache GHC.Types.Bool
instance Text.Mustache.Types.ToMustache ()
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (GHC.Base.Maybe ω)
instance Text.Mustache.Types.ToMustache Data.Text.Internal.Text
instance Text.Mustache.Types.ToMustache Data.Text.Internal.Lazy.Text
instance Text.Mustache.Types.ToMustache Data.Scientific.Scientific
instance Text.Mustache.Types.ToMustache α => Text.Mustache.Types.ToMustache [α]
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Sequence.Seq ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Vector.Vector ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Map.Base.Map Data.Text.Internal.Text ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Map.Base.Map Data.Text.Internal.Lazy.Text ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Map.Base.Map GHC.Base.String ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.HashMap.Base.HashMap Data.Text.Internal.Text ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.HashMap.Base.HashMap Data.Text.Internal.Lazy.Text ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.HashMap.Base.HashMap GHC.Base.String ω)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.Context Text.Mustache.Types.Value -> Text.Mustache.Types.STree -> Text.Mustache.Types.STree)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.Context Text.Mustache.Types.Value -> Text.Mustache.Types.STree -> Data.Text.Internal.Text)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.Context Text.Mustache.Types.Value -> Text.Mustache.Types.STree -> Data.Text.Internal.Lazy.Text)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.Context Text.Mustache.Types.Value -> Text.Mustache.Types.STree -> GHC.Base.String)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.STree -> Text.Mustache.Types.STree)
instance Text.Mustache.Types.ToMustache (Text.Mustache.Types.STree -> Data.Text.Internal.Text)
instance Text.Mustache.Types.ToMustache Data.Aeson.Types.Internal.Value
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.HashSet.HashSet ω)
instance Text.Mustache.Types.ToMustache ω => Text.Mustache.Types.ToMustache (Data.Set.Base.Set ω)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β) => Text.Mustache.Types.ToMustache (α, β)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ) => Text.Mustache.Types.ToMustache (α, β, γ)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ, Text.Mustache.Types.ToMustache δ) => Text.Mustache.Types.ToMustache (α, β, γ, δ)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ, Text.Mustache.Types.ToMustache δ, Text.Mustache.Types.ToMustache ε) => Text.Mustache.Types.ToMustache (α, β, γ, δ, ε)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ, Text.Mustache.Types.ToMustache δ, Text.Mustache.Types.ToMustache ε, Text.Mustache.Types.ToMustache ζ) => Text.Mustache.Types.ToMustache (α, β, γ, δ, ε, ζ)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ, Text.Mustache.Types.ToMustache δ, Text.Mustache.Types.ToMustache ε, Text.Mustache.Types.ToMustache ζ, Text.Mustache.Types.ToMustache η) => Text.Mustache.Types.ToMustache (α, β, γ, δ, ε, ζ, η)
instance (Text.Mustache.Types.ToMustache α, Text.Mustache.Types.ToMustache β, Text.Mustache.Types.ToMustache γ, Text.Mustache.Types.ToMustache δ, Text.Mustache.Types.ToMustache ε, Text.Mustache.Types.ToMustache ζ, Text.Mustache.Types.ToMustache η, Text.Mustache.Types.ToMustache θ) => Text.Mustache.Types.ToMustache (α, β, γ, δ, ε, ζ, η, θ)
instance Language.Haskell.TH.Syntax.Lift Text.Mustache.Types.TemplateCache
instance Language.Haskell.TH.Syntax.Lift Data.Text.Internal.Text
module Text.Mustache.Parser
-- | Runs the parser for a mustache template, returning the syntax tree.
parse :: FilePath -> Text -> Either ParseError STree
-- | Parse using a custom initial configuration
parseWithConf :: MustacheConf -> FilePath -> Text -> Either ParseError STree
-- | Initial configuration for the parser
data MustacheConf
MustacheConf :: (String, String) -> MustacheConf
[delimiters] :: MustacheConf -> (String, String)
-- | Default configuration (delimiters = ("{{", "}}"))
defaultConf :: MustacheConf
-- | The parser monad in use
type Parser = Parsec Text MustacheState
-- | User state for the parser
data MustacheState
-- | -- # --sectionBegin :: Char -- |
-- / --sectionEnd :: Char -- |
-- ^ --invertedSectionBegin :: Char -- | { and } unescape2 :: (Char, Char) -- |
-- & --unescape1 :: Char -- |
-- = --delimiterChange :: Char -- |
-- . --nestingSeparator :: Char module Text.Mustache.Render -- | Substitutes all mustache defined tokens (or tags) for values found in -- the provided data structure. -- -- Equivalent to substituteValue . toMustache. substitute :: ToMustache k => Template -> k -> Text -- | Substitutes all mustache defined tokens (or tags) for values found in -- the provided data structure. substituteValue :: Template -> Value -> Text -- | Substitutes all mustache defined tokens (or tags) for values found in -- the provided data structure and report any errors and warnings -- encountered during substitution. -- -- This function always produces results, as in a fully -- substituted/rendered template, it never halts on errors. It simply -- reports them in the first part of the tuple. Sites with errors are -- usually substituted with empty string. -- -- The second value in the tuple is a template rendered with errors -- ignored. Therefore if you must enforce that there were no errors -- during substitution you must check that the error list in the first -- tuple value is empty. -- -- Equivalent to checkedSubstituteValue . toMustache. checkedSubstitute :: ToMustache k => Template -> k -> ([SubstitutionError], Text) -- | Substitutes all mustache defined tokens (or tags) for values found in -- the provided data structure and report any errors and warnings -- encountered during substitution. -- -- This function always produces results, as in a fully -- substituted/rendered template, it never halts on errors. It simply -- reports them in the first part of the tuple. Sites with errors are -- usually substituted with empty string. -- -- The second value in the tuple is a template rendered with errors -- ignored. Therefore if you must enforce that there were no errors -- during substitution you must check that the error list in the first -- tuple value is empty. checkedSubstituteValue :: Template -> Value -> ([SubstitutionError], Text) -- | Type of errors we may encounter during substitution. data SubstitutionError -- | The template contained a variable for which there was no data -- counterpart in the current context VariableNotFound :: [Key] -> SubstitutionError -- | When substituting an implicit section the current context had an -- unsubstitutable type InvalidImplicitSectionContextType :: String -> SubstitutionError -- | Inverted implicit sections should never occur InvertedImplicitSection :: SubstitutionError -- | The template contained a section for which there was no data -- counterpart in the current context SectionTargetNotFound :: [Key] -> SubstitutionError -- | The template contained a partial for which there was no data -- counterpart in the current context PartialNotFound :: FilePath -> SubstitutionError -- | A complex value such as an Object or Array was directly rendered into -- the template (warning) DirectlyRenderedValue :: Value -> SubstitutionError -- | Representation of stateful context for the substitution process data Context α Context :: [α] -> α -> Context α -- | Search for a key in the current context. -- -- The search is conducted inside out mening the current focus is -- searched first. If the key is not found the outer scopes are -- recursively searched until the key is found, then innerSearch -- is called on the result. search :: Context Value -> [Key] -> Maybe Value -- | Searches nested scopes navigating inward. Fails if it encunters -- something other than an object before the key is expended. innerSearch :: [Key] -> Value -> Maybe Value -- | Converts values to Text as required by the mustache standard toString :: Value -> Substitution Text instance GHC.Show.Show Text.Mustache.Render.SubstitutionError module Text.Mustache.Compile -- | 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) -- | Compile the template with the search space set to only the current -- directory localAutomaticCompile :: FilePath -> IO (Either ParseError Template) -- | A collection of templates with quick access via their hashed names type TemplateCache = HashMap String Template -- | 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) -- | 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 -- | Flatten a list of Templates into a single TemplateChache cacheFromList :: [Template] -> TemplateCache -- | Find the names of all included partials in a mustache STree. -- -- Same as join . fmap getPartials' getPartials :: STree -> [FilePath] -- | 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 ParseErrors to be compatible with the internal -- Either Monad of compileTemplateWithCache. getFile :: [FilePath] -> FilePath -> EitherT ParseError IO Text -- | 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
-- | 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
-- | Compile a mustache Template at compile time. Usage:
--
--
-- {-# LANGUAGE TemplateHaskell #-}
-- import Text.Mustache.Compile (embedTemplate)
--
-- foo :: Template
-- foo = $(embedTemplate "dir/file.mustache")
--
--
-- Partials are not supported in embedSingleTemplate
embedSingleTemplate :: FilePath -> Q Exp
-- | -- main :: IO () -- main = do -- let searchSpace = [".", "./templates"] -- templateName = "main.mustache" -- -- compiled <- automaticCompile searchSpace templateName -- case compiled of -- Left err -> print err -- Right template -> return () -- this is where you can start using it ---- -- The searchSpace encompasses all directories in which the -- compiler should search for the template source files. The search -- itself is conducted in order, from left to right. -- -- Should your search space be only the current working directory, you -- can use localAutomaticCompile. -- -- The templateName is the relative path of the template to any -- directory of the search space. -- -- automaticCompile not only finds and compiles the template for -- you, it also recursively finds any partials included in the template -- as well, compiles them and stores them in the partials hash -- attached to the resulting template. -- -- The compiler will throw errors if either the template is malformed or -- the source file for a partial or the template itself could not be -- found in any of the directories in searchSpace. -- --
-- data Person = { age :: Int, name :: String }
--
-- instance ToMustache Person where
-- toMustache person = object
-- [ "age" ~> age person
-- , "name" ~> name person
-- ]
--
--
-- The values to the left of the ~> operator has to be of type
-- Text, hence the OverloadedStrings can becomes very
-- handy here.
--
-- Values to the right of the ~> operator must be an instance
-- of the ToMustache typeclass. Alternatively, if your value to
-- the right of the ~> operator is not an instance of
-- ToMustache but an instance of ToJSON you can use the
-- ~= operator, which accepts ToJSON values.
--
--
-- data Person = { age :: Int, name :: String, address :: Address }
--
-- data Address = ...
--
-- instance ToJSON Address where
-- ...
--
-- instance ToMustache Person where
-- toMustache person = object
-- [ "age" ~> age person
-- , "name" ~> name person
-- , "address" ~= address person
-- ]
--
--
-- All operators are also provided in a unicode form, for those that,
-- like me, enjoy unicode operators.
--
--
-- data Address = Address { ... }
--
-- instance Address ToJSON where
-- ...
--
-- data Person = Person { name :: String, address :: Address }
--
-- instance ToMustache Person where
-- toMustache (Person { name, address }) = object
-- [ "name" ~> name
-- , "address" ~= address
-- ]
--
--
-- Here we can see that we can use the ~> operator for values
-- that have themselves a ToMustache instance, or alternatively if
-- they lack such an instance but provide an instance for the
-- ToJSON typeclass we can use the ~= operator.
object :: [Pair] -> Value
-- | Map keys to values that provide a ToMustache instance
--
-- Recommended in conjunction with the OverloadedStrings
-- extension.
(~>) :: ToMustache ω => Text -> ω -> Pair
infixr 8 ~>
-- | Map keys to values that provide a ToJSON instance
--
-- Recommended in conjunction with the OverloadedStrings
-- extension.
(~=) :: ToJSON ι => Text -> ι -> Pair
infixr 8 ~=