{-#LANGUAGE FlexibleContexts #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE TupleSections #-}
{-#LANGUAGE TypeSynonymInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE ScopedTypeVariables #-}

-- | The internals of the 'Run' monad, and various things needed to make the
-- magic happen. You will not normally need to import this module;
-- 'Text.Ginger.Run' re-exports the things you probably want. However, if you
-- want to provide your own run monad that extends 'Run' somehow, this module
-- may be of use.
module Text.Ginger.Run.Type
( GingerContext (..)
, makeContext
, makeContextM
, makeContext'
, makeContextM'
, makeContextExM'
, makeContextHtml
, makeContextHtmlM
, makeContextHtmlExM
, makeContextText
, makeContextTextM
, makeContextTextExM
, easyContext
, ContextEncodable (..)
, liftRun
, liftRun2
, Run (..)
, RunState (..)
, RuntimeError (..)
, runtimeErrorWhat
, runtimeErrorWhere
, runtimeErrorMessage
-- * The Newlines type
-- | Required for handling indentation
, Newlines (..)
-- * Hoisting
, hoistContext
, hoistRun
, hoistNewlines
, hoistRunState
, warn
, warnFromMaybe
, throwHere
, withSourcePos
, getSourcePos
)
where

import Prelude ( (.), ($), (==), (/=)
               , (>), (<), (>=), (<=)
               , (+), (-), (*), (/), div, (**), (^)
               , (||), (&&)
               , (++)
               , Show, show
               , undefined, otherwise
               , Maybe (..)
               , Bool (..)
               , Int, Integer, String
               , fromIntegral, floor, round
               , not
               , show
               , uncurry
               , seq
               , fst, snd
               , maybe
               , Either (..)
               , id
               )
import qualified Prelude
import Data.Maybe (fromMaybe, isJust)
import qualified Data.List as List
import Text.Ginger.AST
import Text.Ginger.Html
import Text.Ginger.GVal
import Text.Ginger.Parse (ParserError (..), sourceLine, sourceColumn, sourceName)
import Text.Printf
import Text.PrintfA
import Data.Scientific (formatScientific)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT)
import Data.Default (Default (..), def)

import Data.Char (isSpace)
import Data.Text (Text)
import Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.ByteString.UTF8 as UTF8
import Control.Monad
import Control.Monad.Identity
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Except
import Control.Applicative
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
import Data.Scientific (Scientific)
import Data.Scientific as Scientific
import Data.Default (def)
import Safe (readMay, lastDef, headMay)
import Network.HTTP.Types (urlEncode)
import Debug.Trace (trace)
import Data.Maybe (isNothing)
import Data.Monoid (Monoid (..), (<>))
import Data.List (lookup, zipWith, unzip)

-- | Execution context. Determines how to look up variables from the
-- environment, and how to write out template output.
data GingerContext p m h
    = GingerContext
        { forall p (m :: * -> *) h.
GingerContext p m h -> Text -> Run p m h (GVal (Run p m h))
contextLookup :: VarName -> Run p m h (GVal (Run p m h))
        , forall p (m :: * -> *) h. GingerContext p m h -> h -> Run p m h ()
contextWrite :: h -> Run p m h ()
        , forall p (m :: * -> *) h.
GingerContext p m h -> RuntimeError p -> Run p m h ()
contextWarn :: RuntimeError p -> Run p m h ()
        , forall p (m :: * -> *) h.
GingerContext p m h -> GVal (Run p m h) -> h
contextEncode :: GVal (Run p m h) -> h
        , forall p (m :: * -> *) h. GingerContext p m h -> Maybe (Newlines h)
contextNewlines :: Maybe (Newlines h)
        }

-- | 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.
hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t
hoistContext :: forall (m :: * -> *) h t p.
Monad m =>
(h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t
hoistContext h -> t
fwd t -> h
rev GingerContext p m h
c =
    GingerContext
        { contextLookup :: Text
-> Run
     p
     m
     t
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))))
contextLookup = \Text
varName ->
            (forall a. Run p m h a -> Run p m t a)
-> (forall a. Run p m t a -> Run p m h a)
-> GVal (Run p m h)
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx
                ((h -> t)
-> (t -> h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev)
                ((t -> h)
-> (h -> t)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun t -> h
rev h -> t
fwd) (GVal (Run p m h)
 -> GVal
      (ExceptT
         (RuntimeError p)
         (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     (GVal (Run p m h))
-> Run
     p
     m
     t
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                (h -> t)
-> (t -> h)
-> Run p m h (GVal (Run p m h))
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     (GVal (Run p m h))
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev (GingerContext p m h -> Text -> Run p m h (GVal (Run p m h))
forall p (m :: * -> *) h.
GingerContext p m h -> Text -> Run p m h (GVal (Run p m h))
contextLookup GingerContext p m h
c Text
varName)
        , contextWrite :: t -> Run p m t ()
contextWrite = \t
val ->
            (h -> t) -> (t -> h) -> Run p m h () -> Run p m t ()
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev (GingerContext p m h -> h -> Run p m h ()
forall p (m :: * -> *) h. GingerContext p m h -> h -> Run p m h ()
contextWrite GingerContext p m h
c (h -> Run p m h ()) -> h -> Run p m h ()
forall a b. (a -> b) -> a -> b
$ t -> h
rev t
val)
        , contextWarn :: RuntimeError p -> Run p m t ()
contextWarn = \RuntimeError p
str ->
            (h -> t) -> (t -> h) -> Run p m h () -> Run p m t ()
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev (GingerContext p m h -> RuntimeError p -> Run p m h ()
forall p (m :: * -> *) h.
GingerContext p m h -> RuntimeError p -> Run p m h ()
contextWarn GingerContext p m h
c RuntimeError p
str)
        , contextEncode :: GVal
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
-> t
contextEncode = \GVal
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
gval ->
            h -> t
fwd (h -> t)
-> (GVal
      (ExceptT
         (RuntimeError p)
         (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
    -> h)
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
-> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                GingerContext p m h -> GVal (Run p m h) -> h
forall p (m :: * -> *) h.
GingerContext p m h -> GVal (Run p m h) -> h
contextEncode GingerContext p m h
c (GVal (Run p m h) -> h)
-> (GVal
      (ExceptT
         (RuntimeError p)
         (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
    -> GVal (Run p m h))
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
-> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                (forall a. Run p m t a -> Run p m h a)
-> (forall a. Run p m h a -> Run p m t a)
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
-> GVal (Run p m h)
forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx ((t -> h) -> (h -> t) -> Run p m t a -> Run p m h a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun t -> h
rev h -> t
fwd) ((h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev) (GVal
   (ExceptT
      (RuntimeError p)
      (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
 -> t)
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
-> t
forall a b. (a -> b) -> a -> b
$
                GVal
  (ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m)))
gval
        , contextNewlines :: Maybe (Newlines t)
contextNewlines =
            (h -> t) -> (t -> h) -> Newlines h -> Newlines t
forall h t. (h -> t) -> (t -> h) -> Newlines h -> Newlines t
hoistNewlines h -> t
fwd t -> h
rev (Newlines h -> Newlines t)
-> Maybe (Newlines h) -> Maybe (Newlines t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GingerContext p m h -> Maybe (Newlines h)
forall p (m :: * -> *) h. GingerContext p m h -> Maybe (Newlines h)
contextNewlines GingerContext p m h
c
        }

contextWriteEncoded :: GingerContext p m h -> GVal (Run p m h) -> Run p m h ()
contextWriteEncoded :: forall p (m :: * -> *) h.
GingerContext p m h -> GVal (Run p m h) -> Run p m h ()
contextWriteEncoded GingerContext p m h
context =
    GingerContext p m h -> h -> Run p m h ()
forall p (m :: * -> *) h. GingerContext p m h -> h -> Run p m h ()
contextWrite GingerContext p m h
context (h -> Run p m h ())
-> (GVal (Run p m h) -> h) -> GVal (Run p m h) -> Run p m h ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GingerContext p m h -> GVal (Run p m h) -> h
forall p (m :: * -> *) h.
GingerContext p m h -> GVal (Run p m h) -> h
contextEncode GingerContext p m h
context

easyContext :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v)
            => (h -> m ())
            -> v
            -> GingerContext p m h
easyContext :: forall (m :: * -> *) h p v.
(Monad m, ContextEncodable h, ToGVal (Run p m h) v) =>
(h -> m ()) -> v -> GingerContext p m h
easyContext h -> m ()
emit v
context =
    (h -> m ()) -> (RuntimeError p -> m ()) -> v -> GingerContext p m h
forall (m :: * -> *) h p v.
(Monad m, ContextEncodable h, ToGVal (Run p m h) v) =>
(h -> m ()) -> (RuntimeError p -> m ()) -> v -> GingerContext p m h
easyContextEx h -> m ()
emit (m () -> RuntimeError p -> m ()
forall a b. a -> b -> a
Prelude.const (m () -> RuntimeError p -> m ()) -> m () -> RuntimeError p -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) v
context

easyContextEx :: (Monad m, ContextEncodable h, ToGVal (Run p m h) v)
              => (h -> m ())
              -> (RuntimeError p -> m ())
              -> v
              -> GingerContext p m h
easyContextEx :: forall (m :: * -> *) h p v.
(Monad m, ContextEncodable h, ToGVal (Run p m h) v) =>
(h -> m ()) -> (RuntimeError p -> m ()) -> v -> GingerContext p m h
easyContextEx h -> m ()
emit RuntimeError p -> m ()
warn v
context =
    (Text -> 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
forall (m :: * -> *) p h.
Monad m =>
(Text -> 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
makeContextExM'
        (\Text
varName ->
            GVal (Run p m h) -> Run p m h (GVal (Run p m h))
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (GVal (Run p m h)
-> GVal (Run p m h) -> GVal (Run p m h) -> GVal (Run p m h)
forall (m :: * -> *). GVal m -> GVal m -> GVal m -> GVal m
lookupLooseDef GVal (Run p m h)
forall a. Default a => a
def
                    (Text -> GVal (Run p m h)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal Text
varName)
                    (v -> GVal (Run p m h)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal v
context)))
        h -> m ()
emit
        RuntimeError p -> m ()
warn
        GVal (Run p m h) -> h
forall h (m :: * -> *). ContextEncodable h => GVal m -> h
forall (m :: * -> *). GVal m -> h
encode
        Maybe (Newlines h)
forall h. ContextEncodable h => Maybe (Newlines h)
newlines


-- | Typeclass that defines how to encode 'GVal's into a given type.
class ContextEncodable h where
    encode :: forall m. GVal m -> h
    newlines :: Maybe (Newlines h)
    newlines = Maybe (Newlines h)
forall a. Maybe a
Nothing

-- | Encoding to text just takes the text representation without further
-- processing.
instance ContextEncodable Text where
    encode :: forall (m :: * -> *). GVal m -> Text
encode = GVal m -> Text
forall (m :: * -> *). GVal m -> Text
asText
    newlines :: Maybe (Newlines Text)
newlines = Newlines Text -> Maybe (Newlines Text)
forall a. a -> Maybe a
Just Newlines Text
textNewlines

-- | Encoding to Html is implemented as returning the 'asHtml' representation.
instance ContextEncodable Html where
    encode :: forall (m :: * -> *). GVal m -> Html
encode = GVal m -> Html
forall s. ToHtml s => s -> Html
toHtml
    newlines :: Maybe (Newlines Html)
newlines = Newlines Html -> Maybe (Newlines Html)
forall a. a -> Maybe a
Just Newlines Html
htmlNewlines

-- | 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).
makeContextM' :: Monad 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
makeContextM' :: forall (m :: * -> *) p h.
Monad m =>
(Text -> Run p m h (GVal (Run p m h)))
-> (h -> m ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
makeContextM' Text -> Run p m h (GVal (Run p m h))
lookupFn h -> m ()
writeFn GVal (Run p m h) -> h
encodeFn Maybe (Newlines h)
newlines =
  (Text -> 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
forall (m :: * -> *) p h.
Monad m =>
(Text -> 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
makeContextExM' Text -> Run p m h (GVal (Run p m h))
lookupFn h -> m ()
writeFn (m () -> RuntimeError p -> m ()
forall a b. a -> b -> a
Prelude.const (m () -> RuntimeError p -> m ()) -> m () -> RuntimeError p -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) GVal (Run p m h) -> h
encodeFn Maybe (Newlines h)
newlines

makeContextExM' :: Monad 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
makeContextExM' :: forall (m :: * -> *) p h.
Monad m =>
(Text -> 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
makeContextExM' Text -> Run p m h (GVal (Run p m h))
lookupFn h -> m ()
writeFn RuntimeError p -> m ()
warnFn GVal (Run p m h) -> h
encodeFn Maybe (Newlines h)
newlines =
    GingerContext
        { contextLookup :: Text -> Run p m h (GVal (Run p m h))
contextLookup = Text -> Run p m h (GVal (Run p m h))
lookupFn
        , contextWrite :: h -> Run p m h ()
contextWrite = (h -> m ()) -> h -> Run p m h ()
forall (m :: * -> *) a b p h.
Monad m =>
(a -> m b) -> a -> Run p m h b
liftRun2 h -> m ()
writeFn
        , contextWarn :: RuntimeError p -> Run p m h ()
contextWarn = (RuntimeError p -> m ()) -> RuntimeError p -> Run p m h ()
forall (m :: * -> *) a b p h.
Monad m =>
(a -> m b) -> a -> Run p m h b
liftRun2 RuntimeError p -> m ()
warnFn
        , contextEncode :: GVal (Run p m h) -> h
contextEncode = GVal (Run p m h) -> h
encodeFn
        , contextNewlines :: Maybe (Newlines h)
contextNewlines = Maybe (Newlines h)
newlines
        }

liftLookup :: (Monad m, ToGVal (Run p m h) v) => (VarName -> m v) -> VarName -> Run p m h (GVal (Run p m h))
liftLookup :: forall (m :: * -> *) p h v.
(Monad m, ToGVal (Run p m h) v) =>
(Text -> m v) -> Text -> Run p m h (GVal (Run p m h))
liftLookup Text -> m v
f Text
k = do
    v
v <- m v -> Run p m h v
forall (m :: * -> *) a p h. Monad m => m a -> Run p m h a
liftRun (m v -> Run p m h v) -> m v -> Run p m h v
forall a b. (a -> b) -> a -> b
$ Text -> m v
f Text
k
    GVal (Run p m h) -> Run p m h (GVal (Run p m h))
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run p m h) -> Run p m h (GVal (Run p m h)))
-> (v -> GVal (Run p m h)) -> v -> Run p m h (GVal (Run p m h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> GVal (Run p m h)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal (v -> Run p m h (GVal (Run p m h)))
-> v -> Run p m h (GVal (Run p m h))
forall a b. (a -> b) -> a -> b
$ v
v

-- | 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 'Text.Ginger.GVal' module for details.
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
makeContext' :: forall h p.
Monoid h =>
(Text -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' Text
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT
           (RunState p (Writer h) h)
           (ReaderT (GingerContext p (Writer h) h) (Writer h))))
lookupFn =
    (Text
 -> Run
      p
      (Writer h)
      h
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT
               (RunState p (Writer h) h)
               (ReaderT (GingerContext p (Writer h) h) (Writer h))))))
-> (h -> Writer h ())
-> (GVal
      (ExceptT
         (RuntimeError p)
         (StateT
            (RunState p (Writer h) h)
            (ReaderT (GingerContext p (Writer h) h) (Writer h))))
    -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
forall (m :: * -> *) p h.
Monad m =>
(Text -> Run p m h (GVal (Run p m h)))
-> (h -> m ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
makeContextM'
        (GVal
  (ExceptT
     (RuntimeError p)
     (StateT
        (RunState p (Writer h) h)
        (ReaderT (GingerContext p (Writer h) h) (Writer h))))
-> Run
     p
     (Writer h)
     h
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT
              (RunState p (Writer h) h)
              (ReaderT (GingerContext p (Writer h) h) (Writer h)))))
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT
        (RunState p (Writer h) h)
        (ReaderT (GingerContext p (Writer h) h) (Writer h)))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal
   (ExceptT
      (RuntimeError p)
      (StateT
         (RunState p (Writer h) h)
         (ReaderT (GingerContext p (Writer h) h) (Writer h))))
 -> Run
      p
      (Writer h)
      h
      (GVal
         (ExceptT
            (RuntimeError p)
            (StateT
               (RunState p (Writer h) h)
               (ReaderT (GingerContext p (Writer h) h) (Writer h))))))
-> (Text
    -> GVal
         (ExceptT
            (RuntimeError p)
            (StateT
               (RunState p (Writer h) h)
               (ReaderT (GingerContext p (Writer h) h) (Writer h)))))
-> Text
-> Run
     p
     (Writer h)
     h
     (GVal
        (ExceptT
           (RuntimeError p)
           (StateT
              (RunState p (Writer h) h)
              (ReaderT (GingerContext p (Writer h) h) (Writer h)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> GVal
     (ExceptT
        (RuntimeError p)
        (StateT
           (RunState p (Writer h) h)
           (ReaderT (GingerContext p (Writer h) h) (Writer h))))
lookupFn)
        h -> Writer h ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

{-#DEPRECATED makeContext "Compatibility alias for makeContextHtml" #-}
makeContext :: (VarName -> GVal (Run p (Writer Html) Html))
            -> GingerContext p (Writer Html) Html
makeContext :: forall p.
(Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContext = (Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
forall p.
(Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContextHtml

{-#DEPRECATED makeContextM "Compatibility alias for makeContextHtmlM" #-}
makeContextM :: Monad m
             => (VarName -> Run p m Html (GVal (Run p m Html)))
             -> (Html -> m ())
             -> GingerContext p m Html
makeContextM :: forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
makeContextM = (Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
makeContextHtmlM

makeContextHtml :: (VarName -> GVal (Run p (Writer Html) Html))
                -> GingerContext p (Writer Html) Html
makeContextHtml :: forall p.
(Text -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContextHtml Text -> GVal (Run p (Writer Html) Html)
l = (Text -> GVal (Run p (Writer Html) Html))
-> (GVal (Run p (Writer Html) Html) -> Html)
-> Maybe (Newlines Html)
-> GingerContext p (Writer Html) Html
forall h p.
Monoid h =>
(Text -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' Text -> GVal (Run p (Writer Html) Html)
l GVal (Run p (Writer Html) Html) -> Html
forall s. ToHtml s => s -> Html
toHtml (Newlines Html -> Maybe (Newlines Html)
forall a. a -> Maybe a
Just Newlines Html
htmlNewlines)

makeContextHtmlM :: Monad m
                 => (VarName -> Run p m Html (GVal (Run p m Html)))
                 -> (Html -> m ())
                 -> GingerContext p m Html
makeContextHtmlM :: forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
makeContextHtmlM Text -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w = (Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ())
-> (GVal (Run p m Html) -> Html)
-> Maybe (Newlines Html)
-> GingerContext p m Html
forall (m :: * -> *) p h.
Monad m =>
(Text -> Run p m h (GVal (Run p m h)))
-> (h -> m ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
makeContextM' Text -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w GVal (Run p m Html) -> Html
forall s. ToHtml s => s -> Html
toHtml (Newlines Html -> Maybe (Newlines Html)
forall a. a -> Maybe a
Just Newlines Html
htmlNewlines)

makeContextHtmlExM :: Monad m
                 => (VarName -> Run p m Html (GVal (Run p m Html)))
                 -> (Html -> m ())
                 -> (RuntimeError p -> m ())
                 -> GingerContext p m Html
makeContextHtmlExM :: forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ())
-> (RuntimeError p -> m ())
-> GingerContext p m Html
makeContextHtmlExM Text -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w RuntimeError p -> m ()
warn = (Text -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ())
-> (RuntimeError p -> m ())
-> (GVal (Run p m Html) -> Html)
-> Maybe (Newlines Html)
-> GingerContext p m Html
forall (m :: * -> *) p h.
Monad m =>
(Text -> 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
makeContextExM' Text -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w RuntimeError p -> m ()
warn GVal (Run p m Html) -> Html
forall s. ToHtml s => s -> Html
toHtml (Newlines Html -> Maybe (Newlines Html)
forall a. a -> Maybe a
Just Newlines Html
htmlNewlines)

makeContextText :: (VarName -> GVal (Run p (Writer Text) Text))
                -> GingerContext p (Writer Text) Text
makeContextText :: forall p.
(Text -> GVal (Run p (Writer Text) Text))
-> GingerContext p (Writer Text) Text
makeContextText Text -> GVal (Run p (Writer Text) Text)
l = (Text -> GVal (Run p (Writer Text) Text))
-> (GVal (Run p (Writer Text) Text) -> Text)
-> Maybe (Newlines Text)
-> GingerContext p (Writer Text) Text
forall h p.
Monoid h =>
(Text -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' Text -> GVal (Run p (Writer Text) Text)
l GVal (Run p (Writer Text) Text) -> Text
forall (m :: * -> *). GVal m -> Text
asText (Newlines Text -> Maybe (Newlines Text)
forall a. a -> Maybe a
Just Newlines Text
textNewlines)

makeContextTextM :: Monad m
                 => (VarName -> Run p m Text (GVal (Run p m Text)))
                 -> (Text -> m ())
                 -> GingerContext p m Text
makeContextTextM :: forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ()) -> GingerContext p m Text
makeContextTextM Text -> Run p m Text (GVal (Run p m Text))
l Text -> m ()
w = (Text -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ())
-> (GVal (Run p m Text) -> Text)
-> Maybe (Newlines Text)
-> GingerContext p m Text
forall (m :: * -> *) p h.
Monad m =>
(Text -> Run p m h (GVal (Run p m h)))
-> (h -> m ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
makeContextM' Text -> Run p m Text (GVal (Run p m Text))
l Text -> m ()
w GVal (Run p m Text) -> Text
forall (m :: * -> *). GVal m -> Text
asText (Newlines Text -> Maybe (Newlines Text)
forall a. a -> Maybe a
Just Newlines Text
textNewlines)

makeContextTextExM :: Monad m
                 => (VarName -> Run p m Text (GVal (Run p m Text)))
                 -> (Text -> m ())
                 -> (RuntimeError p -> m ())
                 -> GingerContext p m Text
makeContextTextExM :: forall (m :: * -> *) p.
Monad m =>
(Text -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ())
-> (RuntimeError p -> m ())
-> GingerContext p m Text
makeContextTextExM Text -> Run p m Text (GVal (Run p m Text))
l Text -> m ()
w RuntimeError p -> m ()
warn = (Text -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ())
-> (RuntimeError p -> m ())
-> (GVal (Run p m Text) -> Text)
-> Maybe (Newlines Text)
-> GingerContext p m Text
forall (m :: * -> *) p h.
Monad m =>
(Text -> 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
makeContextExM' Text -> Run p m Text (GVal (Run p m Text))
l Text -> m ()
w RuntimeError p -> m ()
warn GVal (Run p m Text) -> Text
forall (m :: * -> *). GVal m -> Text
asText (Newlines Text -> Maybe (Newlines Text)
forall a. a -> Maybe a
Just Newlines Text
textNewlines)

-- | A 'Newlines' determines the rules by which a 'h' value can be
-- split into lines, how a list of lines can be joined into a single
-- value, and how to remove leading whitespace.
data Newlines h =
    Newlines
        { forall h. Newlines h -> h -> [h]
splitLines :: h -> [h]
        , forall h. Newlines h -> [h] -> h
joinLines :: [h] -> h
        , forall h. Newlines h -> h -> h
stripIndent :: h -> h
        , forall h. Newlines h -> h -> Bool
endsWithNewline :: h -> Bool
        }

-- | Hoist a 'Newlines' onto a different output type.
-- You don't normally need to use this directly; see 'hoistRun' and/or
-- 'hoistContext'.
hoistNewlines :: (h -> t) -> (t -> h) -> Newlines h -> Newlines t
hoistNewlines :: forall h t. (h -> t) -> (t -> h) -> Newlines h -> Newlines t
hoistNewlines h -> t
fwd t -> h
rev Newlines h
n =
    Newlines
        { splitLines :: t -> [t]
splitLines = (h -> t) -> [h] -> [t]
forall a b. (a -> b) -> [a] -> [b]
List.map h -> t
fwd ([h] -> [t]) -> (t -> [h]) -> t -> [t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines h -> h -> [h]
forall h. Newlines h -> h -> [h]
splitLines Newlines h
n (h -> [h]) -> (t -> h) -> t -> [h]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> h
rev
        , joinLines :: [t] -> t
joinLines = h -> t
fwd (h -> t) -> ([t] -> h) -> [t] -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines h -> [h] -> h
forall h. Newlines h -> [h] -> h
joinLines Newlines h
n ([h] -> h) -> ([t] -> [h]) -> [t] -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> h) -> [t] -> [h]
forall a b. (a -> b) -> [a] -> [b]
List.map t -> h
rev
        , stripIndent :: t -> t
stripIndent = h -> t
fwd (h -> t) -> (t -> h) -> t -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines h -> h -> h
forall h. Newlines h -> h -> h
stripIndent Newlines h
n (h -> h) -> (t -> h) -> t -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> h
rev
        , endsWithNewline :: t -> Bool
endsWithNewline = Newlines h -> h -> Bool
forall h. Newlines h -> h -> Bool
endsWithNewline Newlines h
n (h -> Bool) -> (t -> h) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> h
rev
        }

textNewlines :: Newlines Text
textNewlines :: Newlines Text
textNewlines =
    Newlines
        { splitLines :: Text -> [Text]
splitLines = [Text] -> [Text]
reNewline ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Text.splitOn Text
"\n"
        , joinLines :: [Text] -> Text
joinLines = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        , stripIndent :: Text -> Text
stripIndent = Text -> Text
Text.stripStart
        , endsWithNewline :: Text -> Bool
endsWithNewline = (Text
"\n" Text -> Text -> Bool
`Text.isSuffixOf`)
        }

htmlNewlines :: Newlines Html
htmlNewlines :: Newlines Html
htmlNewlines =
    Newlines
        { splitLines :: Html -> [Html]
splitLines = (Text -> Html) -> [Text] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Html
unsafeRawHtml ([Text] -> [Html]) -> (Html -> [Text]) -> Html -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines Text -> Text -> [Text]
forall h. Newlines h -> h -> [h]
splitLines Newlines Text
textNewlines (Text -> [Text]) -> (Html -> Text) -> Html -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlSource
        , joinLines :: [Html] -> Html
joinLines = Text -> Html
unsafeRawHtml (Text -> Html) -> ([Html] -> Text) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines Text -> [Text] -> Text
forall h. Newlines h -> [h] -> h
joinLines Newlines Text
textNewlines ([Text] -> Text) -> ([Html] -> [Text]) -> [Html] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Text) -> [Html] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> Text
htmlSource
        , stripIndent :: Html -> Html
stripIndent = Text -> Html
unsafeRawHtml (Text -> Html) -> (Html -> Text) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines Text -> Text -> Text
forall h. Newlines h -> h -> h
stripIndent Newlines Text
textNewlines (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlSource
        , endsWithNewline :: Html -> Bool
endsWithNewline = Newlines Text -> Text -> Bool
forall h. Newlines h -> h -> Bool
endsWithNewline Newlines Text
textNewlines (Text -> Bool) -> (Html -> Text) -> Html -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
htmlSource
        }

-- | Helper; reinstates newlines after splitting a 'Text' into lines.
reNewline :: [Text] -> [Text]
reNewline :: [Text] -> [Text]
reNewline [] = []
reNewline (Text
"":[]) = []
reNewline (Text
x:[]) = [Text
x]
reNewline (Text
x:Text
"":[]) = [Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"]
reNewline (Text
x:[Text]
xs) = (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
reNewline [Text]
xs

data RunState p m h
    = RunState
        { forall p (m :: * -> *) h.
RunState p m h -> HashMap Text (GVal (Run p m h))
rsScope :: HashMap VarName (GVal (Run p m h))
        , forall p (m :: * -> *) h. RunState p m h -> h
rsCapture :: h
        , forall p (m :: * -> *) h. RunState p m h -> Template p
rsCurrentTemplate :: Template p -- the template we are currently running
        , forall p (m :: * -> *) h. RunState p m h -> Maybe Text
rsCurrentBlockName :: Maybe Text -- the name of the innermost block we're currently in
        , forall p (m :: * -> *) h. RunState p m h -> Maybe [h]
rsIndentation :: Maybe [h] -- current indentation level, if any
        , forall p (m :: * -> *) h. RunState p m h -> Bool
rsAtLineStart :: Bool -- is the next output position the first column
        , forall p (m :: * -> *) h. RunState p m h -> p
rsCurrentSourcePos :: p
        }

-- | Hoist a 'RunState' 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
hoistRunState :: forall (m :: * -> *) h t p.
Monad m =>
(h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
hoistRunState h -> t
fwd t -> h
rev RunState p m h
rs =
    RunState
        { rsScope :: HashMap Text (GVal (Run p m t))
rsScope = (forall a. Run p m h a -> Run p m t a)
-> (forall a. Run p m t a -> Run p m h a)
-> GVal (Run p m h)
-> GVal (Run p m t)
forall (m :: * -> *) (n :: * -> *).
(Functor m, Functor n) =>
(forall a. m a -> n a)
-> (forall a. n a -> m a) -> GVal m -> GVal n
marshalGValEx ((h -> t)
-> (t -> h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev) ((t -> h)
-> (h -> t)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun t -> h
rev h -> t
fwd) (GVal (Run p m h) -> GVal (Run p m t))
-> HashMap Text (GVal (Run p m h))
-> HashMap Text (GVal (Run p m t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunState p m h -> HashMap Text (GVal (Run p m h))
forall p (m :: * -> *) h.
RunState p m h -> HashMap Text (GVal (Run p m h))
rsScope RunState p m h
rs
        , rsCapture :: t
rsCapture = h -> t
fwd (h -> t) -> h -> t
forall a b. (a -> b) -> a -> b
$ RunState p m h -> h
forall p (m :: * -> *) h. RunState p m h -> h
rsCapture RunState p m h
rs
        , rsCurrentTemplate :: Template p
rsCurrentTemplate = RunState p m h -> Template p
forall p (m :: * -> *) h. RunState p m h -> Template p
rsCurrentTemplate RunState p m h
rs
        , rsCurrentBlockName :: Maybe Text
rsCurrentBlockName = RunState p m h -> Maybe Text
forall p (m :: * -> *) h. RunState p m h -> Maybe Text
rsCurrentBlockName RunState p m h
rs
        , rsIndentation :: Maybe [t]
rsIndentation = (h -> t) -> [h] -> [t]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap h -> t
fwd ([h] -> [t]) -> Maybe [h] -> Maybe [t]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunState p m h -> Maybe [h]
forall p (m :: * -> *) h. RunState p m h -> Maybe [h]
rsIndentation RunState p m h
rs
        , rsAtLineStart :: Bool
rsAtLineStart = RunState p m h -> Bool
forall p (m :: * -> *) h. RunState p m h -> Bool
rsAtLineStart RunState p m h
rs
        , rsCurrentSourcePos :: p
rsCurrentSourcePos = RunState p m h -> p
forall p (m :: * -> *) h. RunState p m h -> p
rsCurrentSourcePos RunState p m h
rs
        }

data RuntimeError p = 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
                    -- | Wrong type, expected one of...
                    | TypeError [Text] (Maybe Text)
                    -- | Invalid index
                    | IndexError Text
                    | EvalParseError ParserError
                    | NotAFunctionError
                    | RuntimeErrorAt p (RuntimeError p)
        deriving (Int -> RuntimeError p -> ShowS
[RuntimeError p] -> ShowS
RuntimeError p -> String
(Int -> RuntimeError p -> ShowS)
-> (RuntimeError p -> String)
-> ([RuntimeError p] -> ShowS)
-> Show (RuntimeError p)
forall p. Show p => Int -> RuntimeError p -> ShowS
forall p. Show p => [RuntimeError p] -> ShowS
forall p. Show p => RuntimeError p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Show p => Int -> RuntimeError p -> ShowS
showsPrec :: Int -> RuntimeError p -> ShowS
$cshow :: forall p. Show p => RuntimeError p -> String
show :: RuntimeError p -> String
$cshowList :: forall p. Show p => [RuntimeError p] -> ShowS
showList :: [RuntimeError p] -> ShowS
Show)

instance Default (RuntimeError p) where
    def :: RuntimeError p
def = Text -> RuntimeError p
forall p. Text -> RuntimeError p
RuntimeError Text
""

instance ToGVal m p => ToGVal m (RuntimeError p) where
    toGVal :: RuntimeError p -> GVal m
toGVal = RuntimeError p -> GVal m
forall (m :: * -> *) p. ToGVal m p => RuntimeError p -> GVal m
runtimeErrorToGVal

runtimeErrorWhat :: RuntimeError p -> Text
runtimeErrorWhat :: forall p. RuntimeError p -> Text
runtimeErrorWhat (ArgumentsError Maybe Text
funcName Text
explanation) = Text
"ArgumentsError"
runtimeErrorWhat (EvalParseError ParserError
e) = Text
"EvalParseError"
runtimeErrorWhat (RuntimeError Text
msg) = Text
"RuntimeError"
runtimeErrorWhat (UndefinedBlockError Text
blockName) = Text
"UndefinedBlockError"
runtimeErrorWhat RuntimeError p
NotAFunctionError = Text
"NotAFunctionError"
runtimeErrorWhat (IndexError Text
_) = Text
"IndexError"
runtimeErrorWhat (TypeError [Text]
_ Maybe Text
_) = Text
"TypeError"
runtimeErrorWhat (RuntimeErrorAt p
_ RuntimeError p
e) = RuntimeError p -> Text
forall p. RuntimeError p -> Text
runtimeErrorWhat RuntimeError p
e

runtimeErrorMessage :: RuntimeError p -> Text
runtimeErrorMessage :: forall p. RuntimeError p -> Text
runtimeErrorMessage (ArgumentsError Maybe Text
Nothing Text
explanation) =
    Text
"invalid arguments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
explanation
runtimeErrorMessage (ArgumentsError (Just Text
funcName) Text
explanation) =
    Text
"invalid arguments to function '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
funcName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
explanation
runtimeErrorMessage (TypeError [Text]
expected Maybe Text
actual) =
    Text
"wrong type"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case [Text]
expected of
        [] -> Text
""
        [Text
x] -> Text
", expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
        [Text]
xs -> Text
", expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse Text
" or " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
xs)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Text
actual of
        Maybe Text
Nothing -> Text
""
        Just Text
x -> Text
", found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
runtimeErrorMessage (IndexError Text
i) =
    Text
"invalid index " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
i
runtimeErrorMessage (EvalParseError ParserError
e) =
    Text
"parser error in eval()-ed code: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (ParserError -> String
peErrorMessage ParserError
e)
runtimeErrorMessage (RuntimeError Text
msg) =
    Text
msg
runtimeErrorMessage (UndefinedBlockError Text
blockName) =
    Text
"undefined block: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
blockName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
runtimeErrorMessage RuntimeError p
NotAFunctionError =
    Text
"attempted to call something that is not a function"
runtimeErrorMessage (RuntimeErrorAt p
_ RuntimeError p
e) =
    RuntimeError p -> Text
forall p. RuntimeError p -> Text
runtimeErrorMessage RuntimeError p
e

runtimeErrorWhere :: RuntimeError p -> [p]
runtimeErrorWhere :: forall p. RuntimeError p -> [p]
runtimeErrorWhere (RuntimeErrorAt p
p RuntimeError p
e) = p
pp -> [p] -> [p]
forall a. a -> [a] -> [a]
:RuntimeError p -> [p]
forall p. RuntimeError p -> [p]
runtimeErrorWhere RuntimeError p
e
runtimeErrorWhere RuntimeError p
_ = []

runtimeErrorToGVal :: forall m p. ToGVal m p => RuntimeError p -> GVal m
runtimeErrorToGVal :: forall (m :: * -> *) p. ToGVal m p => RuntimeError p -> GVal m
runtimeErrorToGVal RuntimeError p
e =
    let ([p]
callStack, [(Text, GVal m)]
props) = RuntimeError p -> ([p], [(Text, GVal m)])
forall p (m :: * -> *). RuntimeError p -> ([p], [(Text, GVal m)])
runtimeErrorToGValRaw RuntimeError p
e
        props' :: [Pair m]
props' = ((Text
"callStack" :: Text) Text -> [p] -> Pair m
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [p]
callStack)Pair m -> [Pair m] -> [Pair m]
forall a. a -> [a] -> [a]
:[Pair m]
forall {m :: * -> *}. [(Text, GVal m)]
props
    in ([Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
dict [Pair m]
props') { asText = runtimeErrorMessage e }

runtimeErrorToGValRaw :: RuntimeError p -> ([p], [(Text, GVal m)])
runtimeErrorToGValRaw :: forall p (m :: * -> *). RuntimeError p -> ([p], [(Text, GVal m)])
runtimeErrorToGValRaw (RuntimeError Text
msg) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"RuntimeError" []
    )
runtimeErrorToGValRaw (UndefinedBlockError Text
blockName) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"UndefinedBlockError"
        [ Text
"block" Text -> Text -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Text
blockName
        ]
    )
runtimeErrorToGValRaw (ArgumentsError Maybe Text
funcName Text
explanation) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"ArgumentsError"
        [ Text
"explanation" Text -> Text -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Text
explanation
        , Text
"function" Text -> Maybe Text -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Maybe Text
funcName
        ]
    )
runtimeErrorToGValRaw (TypeError [Text]
expected Maybe Text
Nothing) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"ArgumentsError"
        [ Text
"expected" Text -> [Text] -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [Text]
expected
        ]
    )
runtimeErrorToGValRaw (TypeError [Text]
expected (Just Text
actual)) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"ArgumentsError"
        [ Text
"expected" Text -> [Text] -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> [Text]
expected
        , Text
"actual" Text -> Text -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Text
actual
        ]
    )
runtimeErrorToGValRaw (EvalParseError ParserError
e) =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"EvalParseError"
        [ Text
"errorMessage" Text -> String -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> ParserError -> String
peErrorMessage ParserError
e
        -- , "sourcePosition" ~> peSourcePosition e
        ]
    )
runtimeErrorToGValRaw RuntimeError p
NotAFunctionError =
    ( []
    , Text -> [(Text, GVal m)] -> [(Text, GVal m)]
forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
"NotAFunctionError"
        []
    )

runtimeErrorToGValRaw (RuntimeErrorAt p
p RuntimeError p
e) =
    let ([p]
callStack, [(Text, GVal m)]
inner) = RuntimeError p -> ([p], [(Text, GVal m)])
forall p (m :: * -> *). RuntimeError p -> ([p], [(Text, GVal m)])
runtimeErrorToGValRaw RuntimeError p
e
    in (p
pp -> [p] -> [p]
forall a. a -> [a] -> [a]
:[p]
callStack, [(Text, GVal m)]
forall {m :: * -> *}. [(Text, GVal m)]
inner)

rteGVal :: Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal :: forall (m :: * -> *). Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal Text
what [(Text, GVal m)]
extra =
    ( [ Text
"what" Text -> Text -> (Text, GVal m)
forall (m :: * -> *) a. ToGVal m a => Text -> a -> Pair m
~> Text
what
      ]
      [(Text, GVal m)] -> [(Text, GVal m)] -> [(Text, GVal m)]
forall a. [a] -> [a] -> [a]
++ [(Text, GVal m)]
extra
    )

-- | Internal type alias for our template-runner monad stack.
type Run p m h = ExceptT (RuntimeError p) (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))

-- | Lift a value from the host monad @m@ into the 'Run' monad.
liftRun :: Monad m => m a -> Run p m h a
liftRun :: forall (m :: * -> *) a p h. Monad m => m a -> Run p m h a
liftRun = StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (RuntimeError p) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a
 -> ExceptT
      (RuntimeError p)
      (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
      a)
-> (m a
    -> StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a)
-> m a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (GingerContext p m h) m a
-> StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (RunState p m h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (GingerContext p m h) m a
 -> StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a)
-> (m a -> ReaderT (GingerContext p m h) m a)
-> m a
-> StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (GingerContext p m h) m a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (GingerContext p m h) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Lift a function from the host monad @m@ into the 'Run' monad.
liftRun2 :: Monad m => (a -> m b) -> a -> Run p m h b
liftRun2 :: forall (m :: * -> *) a b p h.
Monad m =>
(a -> m b) -> a -> Run p m h b
liftRun2 a -> m b
f a
x = m b -> Run p m h b
forall (m :: * -> *) a p h. Monad m => m a -> Run p m h a
liftRun (m b -> Run p m h b) -> m b -> Run p m h b
forall a b. (a -> b) -> a -> b
$ a -> m b
f a
x

-- | 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.
hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun :: forall (m :: * -> *) h t p a.
Monad m =>
(h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun h -> t
fwd t -> h
rev Run p m h a
action = do
    GingerContext p m t
contextT <- ExceptT
  (RuntimeError p)
  (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
  (GingerContext p m t)
forall r (m :: * -> *). MonadReader r m => m r
ask
    let contextH :: GingerContext p m h
contextH = (t -> h) -> (h -> t) -> GingerContext p m t -> GingerContext p m h
forall (m :: * -> *) h t p.
Monad m =>
(h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t
hoistContext t -> h
rev h -> t
fwd GingerContext p m t
contextT
    RunState p m t
stateT <- ExceptT
  (RuntimeError p)
  (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
  (RunState p m t)
forall s (m :: * -> *). MonadState s m => m s
get
    let stateH :: RunState p m h
stateH = (t -> h) -> (h -> t) -> RunState p m t -> RunState p m h
forall (m :: * -> *) h t p.
Monad m =>
(h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
hoistRunState t -> h
rev h -> t
fwd RunState p m t
stateT
    (Either (RuntimeError p) a
x, RunState p m h
stateH') <- StateT
  (RunState p m t)
  (ReaderT (GingerContext p m t) m)
  (Either (RuntimeError p) a, RunState p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     (Either (RuntimeError p) a, RunState p m h)
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT (RuntimeError p) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT
   (RunState p m t)
   (ReaderT (GingerContext p m t) m)
   (Either (RuntimeError p) a, RunState p m h)
 -> ExceptT
      (RuntimeError p)
      (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
      (Either (RuntimeError p) a, RunState p m h))
-> (m (Either (RuntimeError p) a, RunState p m h)
    -> StateT
         (RunState p m t)
         (ReaderT (GingerContext p m t) m)
         (Either (RuntimeError p) a, RunState p m h))
-> m (Either (RuntimeError p) a, RunState p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     (Either (RuntimeError p) a, RunState p m h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  (GingerContext p m t) m (Either (RuntimeError p) a, RunState p m h)
-> StateT
     (RunState p m t)
     (ReaderT (GingerContext p m t) m)
     (Either (RuntimeError p) a, RunState p m h)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (RunState p m t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT
   (GingerContext p m t) m (Either (RuntimeError p) a, RunState p m h)
 -> StateT
      (RunState p m t)
      (ReaderT (GingerContext p m t) m)
      (Either (RuntimeError p) a, RunState p m h))
-> (m (Either (RuntimeError p) a, RunState p m h)
    -> ReaderT
         (GingerContext p m t)
         m
         (Either (RuntimeError p) a, RunState p m h))
-> m (Either (RuntimeError p) a, RunState p m h)
-> StateT
     (RunState p m t)
     (ReaderT (GingerContext p m t) m)
     (Either (RuntimeError p) a, RunState p m h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (RuntimeError p) a, RunState p m h)
-> ReaderT
     (GingerContext p m t) m (Either (RuntimeError p) a, RunState p m h)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (GingerContext p m t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either (RuntimeError p) a, RunState p m h)
 -> ExceptT
      (RuntimeError p)
      (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
      (Either (RuntimeError p) a, RunState p m h))
-> m (Either (RuntimeError p) a, RunState p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     (Either (RuntimeError p) a, RunState p m h)
forall a b. (a -> b) -> a -> b
$ ReaderT
  (GingerContext p m h) m (Either (RuntimeError p) a, RunState p m h)
-> GingerContext p m h
-> m (Either (RuntimeError p) a, RunState p m h)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT
  (RunState p m h)
  (ReaderT (GingerContext p m h) m)
  (Either (RuntimeError p) a)
-> RunState p m h
-> ReaderT
     (GingerContext p m h) m (Either (RuntimeError p) a, RunState p m h)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Run p m h a
-> StateT
     (RunState p m h)
     (ReaderT (GingerContext p m h) m)
     (Either (RuntimeError p) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT Run p m h a
action) RunState p m h
stateH) GingerContext p m h
contextH
    let stateT' :: RunState p m t
stateT' = (h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
forall (m :: * -> *) h t p.
Monad m =>
(h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
hoistRunState h -> t
fwd t -> h
rev RunState p m h
stateH'
    RunState p m t
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put RunState p m t
stateT'
    (RuntimeError p -> Run p m t a)
-> (a -> Run p m t a) -> Either (RuntimeError p) a -> Run p m t a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
Prelude.either RuntimeError p -> Run p m t a
forall a.
RuntimeError p
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> Run p m t a
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (RuntimeError p) a
x

warn :: (Monad m) => RuntimeError p -> Run p m h ()
warn :: forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn RuntimeError p
err = do
    p
pos <- Run p m h p
forall (m :: * -> *) p h. Monad m => Run p m h p
getSourcePos
    RuntimeError p -> Run p m h ()
warnFn <- (GingerContext p m h -> RuntimeError p -> Run p m h ())
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     (RuntimeError p -> Run p m h ())
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GingerContext p m h -> RuntimeError p -> Run p m h ()
forall p (m :: * -> *) h.
GingerContext p m h -> RuntimeError p -> Run p m h ()
contextWarn
    RuntimeError p -> Run p m h ()
warnFn (RuntimeError p -> Run p m h ()) -> RuntimeError p -> Run p m h ()
forall a b. (a -> b) -> a -> b
$ p -> RuntimeError p -> RuntimeError p
forall p. p -> RuntimeError p -> RuntimeError p
RuntimeErrorAt p
pos RuntimeError p
err

warnFromMaybe :: Monad m => RuntimeError p -> a -> Maybe a -> Run p m h a
warnFromMaybe :: forall (m :: * -> *) p a h.
Monad m =>
RuntimeError p -> a -> Maybe a -> Run p m h a
warnFromMaybe RuntimeError p
err a
d Maybe a
Nothing = RuntimeError p -> Run p m h ()
forall (m :: * -> *) p h. Monad m => RuntimeError p -> Run p m h ()
warn RuntimeError p
err Run p m h ()
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall a b.
ExceptT
  (RuntimeError p)
  (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
  a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     b
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
warnFromMaybe RuntimeError p
_ a
d (Just a
x) = a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall a.
a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

setSourcePos :: Monad m
             => p
             -> Run p m h ()
setSourcePos :: forall (m :: * -> *) p h. Monad m => p -> Run p m h ()
setSourcePos p
pos =
  (RunState p m h -> RunState p m h)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsCurrentSourcePos = pos })

getSourcePos :: Monad m
             => Run p m h p
getSourcePos :: forall (m :: * -> *) p h. Monad m => Run p m h p
getSourcePos = (RunState p m h -> p)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     p
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RunState p m h -> p
forall p (m :: * -> *) h. RunState p m h -> p
rsCurrentSourcePos

throwHere :: Monad m => RuntimeError p -> Run p m h a
throwHere :: forall (m :: * -> *) p h a.
Monad m =>
RuntimeError p -> Run p m h a
throwHere RuntimeError p
err = do
    p
pos <- Run p m h p
forall (m :: * -> *) p h. Monad m => Run p m h p
getSourcePos
    RuntimeError p -> Run p m h a
forall a.
RuntimeError p
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError p -> Run p m h a) -> RuntimeError p -> Run p m h a
forall a b. (a -> b) -> a -> b
$ p -> RuntimeError p -> RuntimeError p
forall p. p -> RuntimeError p -> RuntimeError p
RuntimeErrorAt p
pos RuntimeError p
err

-- | @withSourcePos pos action@ runs @action@ in a context where the
-- current source location is set to @pos@. The original source position is
-- restored when @action@ finishes.
withSourcePos :: Monad m
              => p
              -> Run p m h a
              -> Run p m h a
withSourcePos :: forall (m :: * -> *) p h a.
Monad m =>
p -> Run p m h a -> Run p m h a
withSourcePos p
pos Run p m h a
a = do
  p
oldPos <- Run p m h p
forall (m :: * -> *) p h. Monad m => Run p m h p
getSourcePos
  Run p m h a -> (RuntimeError p -> Run p m h a) -> Run p m h a
forall a.
ExceptT
  (RuntimeError p)
  (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
  a
-> (RuntimeError p
    -> ExceptT
         (RuntimeError p)
         (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
         a)
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
    (p -> Run p m h ()
forall (m :: * -> *) p h. Monad m => p -> Run p m h ()
setSourcePos p
pos Run p m h () -> Run p m h a -> Run p m h a
forall a b.
ExceptT
  (RuntimeError p)
  (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
  a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     b
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Run p m h a
a Run p m h a -> Run p m h () -> Run p m h a
forall a b.
ExceptT
  (RuntimeError p)
  (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
  a
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     b
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* p -> Run p m h ()
forall (m :: * -> *) p h. Monad m => p -> Run p m h ()
setSourcePos p
oldPos)
    (\RuntimeError p
err -> RuntimeError p -> Run p m h a
forall a.
RuntimeError p
-> ExceptT
     (RuntimeError p)
     (StateT (RunState p m h) (ReaderT (GingerContext p m h) m))
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RuntimeError p -> Run p m h a) -> RuntimeError p -> Run p m h a
forall a b. (a -> b) -> a -> b
$ p -> RuntimeError p -> RuntimeError p
forall p. p -> RuntimeError p -> RuntimeError p
RuntimeErrorAt p
oldPos RuntimeError p
err)