Safe Haskell | None |
---|---|
Language | Haskell2010 |
Execute Ginger templates in an arbitrary monad.
Usage example:
render :: Template -> Text -> Text -> Text render template username imageURL = do let contextLookup varName = case varName of "username" -> toGVal username "imageURL" -> toGVal imageURL _ -> def -- def for GVal is equivalent to a NULL value context = makeContextHtml contextLookup in htmlSource $ runGinger context template
Synopsis
- easyRenderM :: (Monad m, ContextEncodable h, Monoid h, ToGVal (Run p m h) v, ToGVal (Run p m h) h, ToGVal (Run p m h) p) => (h -> m ()) -> v -> Template p -> m (Either (RuntimeError p) (GVal (Run p m h)))
- easyRender :: (ContextEncodable h, Monoid h, ToGVal (Run p (Writer h) h) v, ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p) => v -> Template p -> h
- easyContext :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v) => (h -> m ()) -> v -> GingerContext p m h
- runGingerT :: (ToGVal (Run p m h) h, ToGVal (Run p m h) p, Monoid h, Monad m, Applicative m, Functor m) => GingerContext p m h -> Template p -> m (Either (RuntimeError p) (GVal (Run p m h)))
- runGinger :: (ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p, Monoid h) => GingerContext p (Writer h) h -> Template p -> h
- makeContext :: (VarName -> GVal (Run p (Writer Html) Html)) -> GingerContext p (Writer Html) Html
- makeContextM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html
- makeContext' :: Monoid h => (VarName -> GVal (Run p (Writer h) h)) -> (GVal (Run p (Writer h) h) -> h) -> Maybe (Newlines h) -> GingerContext p (Writer h) h
- makeContextM' :: (Monad m, Functor m) => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (GVal (Run p m h) -> h) -> Maybe (Newlines h) -> GingerContext p m h
- makeContextExM' :: (Monad m, Functor m) => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (RuntimeError p -> m ()) -> (GVal (Run p m h) -> h) -> Maybe (Newlines h) -> GingerContext p m h
- makeContextHtml :: (VarName -> GVal (Run p (Writer Html) Html)) -> GingerContext p (Writer Html) Html
- makeContextHtmlM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html
- makeContextHtmlExM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> (RuntimeError p -> m ()) -> GingerContext p m Html
- makeContextText :: (VarName -> GVal (Run p (Writer Text) Text)) -> GingerContext p (Writer Text) Text
- makeContextTextM :: (Monad m, Functor m) => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> GingerContext p m Text
- makeContextTextExM :: (Monad m, Functor m) => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> (RuntimeError p -> m ()) -> GingerContext p m Text
- data GingerContext p m h
- type Run p m h = ExceptT (RuntimeError p) (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
- liftRun :: Monad m => m a -> Run p m h a
- liftRun2 :: Monad m => (a -> m b) -> a -> Run p m h b
- extractArgs :: [Text] -> [(Maybe Text, a)] -> (HashMap Text a, [a], HashMap Text a, [Text])
- extractArgsT :: ([Maybe a] -> b) -> [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) b
- extractArgsL :: [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [Maybe a]
- extractArgsDefL :: [(Text, a)] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [a]
- hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t
- hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
- hoistNewlines :: (h -> t) -> (t -> h) -> Newlines h -> Newlines t
- hoistRunState :: Monad m => (h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
- data RuntimeError p
- runtimeErrorWhat :: RuntimeError p -> Text
- runtimeErrorWhere :: RuntimeError p -> [p]
- runtimeErrorMessage :: RuntimeError p -> Text
The "easy" interface
Provides a straightforward way of rendering templates monadically as well as purely.
easyRenderM :: (Monad m, ContextEncodable h, Monoid h, ToGVal (Run p m h) v, ToGVal (Run p m h) h, ToGVal (Run p m h) p) => (h -> m ()) -> v -> Template p -> m (Either (RuntimeError p) (GVal (Run p m h))) Source #
Simplified interface to render a ginger template "into" a monad.
easyRenderM emit context template
renders the template
with the
given context
object (which should represent some sort of
dictionary-like object) by feeding any output to the emit
function.
easyRender :: (ContextEncodable h, Monoid h, ToGVal (Run p (Writer h) h) v, ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p) => v -> Template p -> h Source #
Simplified interface to render a ginger template in a pure fashion.
easyRender context template
renders the template
with the
given context
object (which should represent some sort of
dictionary-like object) by returning the concatenated output.
easyContext :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v) => (h -> m ()) -> v -> GingerContext p m h Source #
The "direct" interface
This interface gives more control than the easy interface, at the expense of requiring more yak shaving.
runGingerT :: (ToGVal (Run p m h) h, ToGVal (Run p m h) p, Monoid h, Monad m, Applicative m, Functor m) => GingerContext p m h -> Template p -> m (Either (RuntimeError p) (GVal (Run p m h))) Source #
Monadically run a Ginger template. The m
parameter is the carrier monad.
runGinger :: (ToGVal (Run p (Writer h) h) h, ToGVal (Run p (Writer h) h) p, Monoid h) => GingerContext p (Writer h) h -> Template p -> h Source #
Purely expand a Ginger template. The underlying carrier monad is Writer
h
, which is used to collect the output and render it into a h
value.
makeContext :: (VarName -> GVal (Run p (Writer Html) Html)) -> GingerContext p (Writer Html) Html Source #
Deprecated: Compatibility alias for makeContextHtml
makeContextM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html Source #
Deprecated: Compatibility alias for makeContextHtmlM
makeContext' :: Monoid h => (VarName -> GVal (Run p (Writer h) h)) -> (GVal (Run p (Writer h) h) -> h) -> Maybe (Newlines h) -> GingerContext p (Writer h) h Source #
Create an execution context for runGinger.
The argument is a lookup function that maps top-level context keys to ginger
values. makeContext
is a specialized version of makeContextM
, targeting
the Writer
Html
monad (which is what is used for the non-monadic
template interpreter runGinger
).
The type of the lookup function may look intimidating, but in most cases,
marshalling values from Haskell to Ginger is a matter of calling toGVal
on them, so the 'GVal (Run (Writer Html))' part can usually be ignored.
See the GVal
module for details.
makeContextM' :: (Monad m, Functor m) => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (GVal (Run p m h) -> h) -> Maybe (Newlines h) -> GingerContext p m h Source #
Create an execution context for runGingerT.
Takes a lookup function, which returns ginger values into the carrier monad
based on a lookup key, and a writer function (outputting HTML by whatever
means the carrier monad provides, e.g. putStr
for IO
, or tell
for
Writer
s).
makeContextExM' :: (Monad m, Functor m) => (VarName -> Run p m h (GVal (Run p m h))) -> (h -> m ()) -> (RuntimeError p -> m ()) -> (GVal (Run p m h) -> h) -> Maybe (Newlines h) -> GingerContext p m h Source #
makeContextHtml :: (VarName -> GVal (Run p (Writer Html) Html)) -> GingerContext p (Writer Html) Html Source #
makeContextHtmlM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> GingerContext p m Html Source #
makeContextHtmlExM :: (Monad m, Functor m) => (VarName -> Run p m Html (GVal (Run p m Html))) -> (Html -> m ()) -> (RuntimeError p -> m ()) -> GingerContext p m Html Source #
makeContextText :: (VarName -> GVal (Run p (Writer Text) Text)) -> GingerContext p (Writer Text) Text Source #
makeContextTextM :: (Monad m, Functor m) => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> GingerContext p m Text Source #
makeContextTextExM :: (Monad m, Functor m) => (VarName -> Run p m Text (GVal (Run p m Text))) -> (Text -> m ()) -> (RuntimeError p -> m ()) -> GingerContext p m Text Source #
The context type
data GingerContext p m h Source #
Execution context. Determines how to look up variables from the environment, and how to write out template output.
The Run monad
type Run p m h = ExceptT (RuntimeError p) (StateT (RunState p m h) (ReaderT (GingerContext p m h) m)) Source #
Internal type alias for our template-runner monad stack.
liftRun :: Monad m => m a -> Run p m h a Source #
Lift a value from the host monad m
into the Run
monad.
liftRun2 :: Monad m => (a -> m b) -> a -> Run p m h b Source #
Lift a function from the host monad m
into the Run
monad.
Helper functions for interpreting argument lists
extractArgs :: [Text] -> [(Maybe Text, a)] -> (HashMap Text a, [a], HashMap Text a, [Text]) Source #
Match args according to a given arg spec, Python style.
The return value is a triple of (matched, args, kwargs, unmatchedNames)
,
where matches
is a hash map of named captured arguments, args is a list of
remaining unmatched positional arguments, kwargs is a list of remaining
unmatched named arguments, and unmatchedNames
contains the argument names
that haven't been matched.
extractArgsT :: ([Maybe a] -> b) -> [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) b Source #
Parse argument list into type-safe argument structure.
extractArgsL :: [Text] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [Maybe a] Source #
Parse argument list into flat list of matched arguments.
extractArgsDefL :: [(Text, a)] -> [(Maybe Text, a)] -> Either ([a], HashMap Text a, [Text]) [a] Source #
Hoisting
hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t Source #
Hoist a context onto a different output type.
hoistContext fwd rev context
returns a context over a different
output type, applying the fwd
and rev
projections to convert
between the original and desired output types.
hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run p m h a -> Run p m t a Source #
Hoist a Run
action onto a different output type.
hoistRun fwd rev action
hoists the action
from Run p m h a
to
Run p m t a
, applying fwd
and rev
to convert between the output
types.
hoistNewlines :: (h -> t) -> (t -> h) -> Newlines h -> Newlines t Source #
Hoist a Newlines
onto a different output type.
You don't normally need to use this directly; see hoistRun
and/or
hoistContext
.
hoistRunState :: Monad m => (h -> t) -> (t -> h) -> RunState p m h -> RunState p m t Source #
Hoist a RunState
onto a different output type.
You don't normally need to use this directly; see hoistRun
and/or
hoistContext
.
Errors
data RuntimeError p Source #
RuntimeError Text | Generic runtime error |
UndefinedBlockError Text | Tried to use a block that isn't defined | Invalid arguments to function (function name, explanation) |
ArgumentsError (Maybe Text) Text | |
TypeError [Text] (Maybe Text) | Wrong type, expected one of... |
IndexError Text | Invalid index |
EvalParseError ParserError | |
NotAFunctionError | |
RuntimeErrorAt p (RuntimeError p) |
Instances
ToGVal m p => ToGVal m (RuntimeError p) Source # | |
Defined in Text.Ginger.Run.Type toGVal :: RuntimeError p -> GVal m Source # | |
Show p => Show (RuntimeError p) Source # | |
Defined in Text.Ginger.Run.Type showsPrec :: Int -> RuntimeError p -> ShowS # show :: RuntimeError p -> String # showList :: [RuntimeError p] -> ShowS # | |
Default (RuntimeError p) Source # | |
Defined in Text.Ginger.Run.Type def :: RuntimeError p # |
runtimeErrorWhat :: RuntimeError p -> Text Source #
runtimeErrorWhere :: RuntimeError p -> [p] Source #
runtimeErrorMessage :: RuntimeError p -> Text Source #