{-#LANGUAGE FlexibleContexts #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE TupleSections #-}
{-#LANGUAGE TypeSynonymInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE ScopedTypeVariables #-}
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
, Newlines (..)
, 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.Except (ExceptT (..))
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.List (lookup, zipWith, unzip)
data GingerContext p m h
= GingerContext
{ GingerContext p m h -> VarName -> Run p m h (GVal (Run p m h))
contextLookup :: VarName -> Run p m h (GVal (Run p m h))
, GingerContext p m h -> h -> Run p m h ()
contextWrite :: h -> Run p m h ()
, GingerContext p m h -> RuntimeError p -> Run p m h ()
contextWarn :: RuntimeError p -> Run p m h ()
, GingerContext p m h -> GVal (Run p m h) -> h
contextEncode :: GVal (Run p m h) -> h
, GingerContext p m h -> Maybe (Newlines h)
contextNewlines :: Maybe (Newlines h)
}
hoistContext :: Monad m => (h -> t) -> (t -> h) -> GingerContext p m h -> GingerContext p m t
hoistContext :: (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 :: forall p (m :: * -> *) h.
(VarName -> Run p m h (GVal (Run p m h)))
-> (h -> Run p m h ())
-> (RuntimeError p -> Run p m h ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
GingerContext
{ contextLookup :: VarName -> Run p m t (GVal (Run p m t))
contextLookup = \VarName
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 (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) -> 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)
((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) (GVal (Run p m h) -> GVal (Run p m t))
-> ExceptT
(RuntimeError p)
(StateT (RunState p m t) (ReaderT (GingerContext p m t) m))
(GVal (Run p m h))
-> Run p m t (GVal (Run p m t))
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 -> VarName -> Run p m h (GVal (Run p m h))
forall p (m :: * -> *) h.
GingerContext p m h -> VarName -> Run p m h (GVal (Run p m h))
contextLookup GingerContext p m h
c VarName
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 (Run p m t) -> t
contextEncode = \GVal (Run p m t)
gval ->
h -> t
fwd (h -> t) -> (GVal (Run p m t) -> h) -> GVal (Run p m t) -> 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 (Run p m t) -> GVal (Run p m h)) -> GVal (Run p m t) -> 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 (Run p m t)
-> 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 (Run p m t) -> t) -> GVal (Run p m t) -> t
forall a b. (a -> b) -> a -> b
$
GVal (Run p m t)
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 :: 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 :: (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 (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 :: (h -> m ()) -> (RuntimeError p -> m ()) -> v -> GingerContext p m h
easyContextEx h -> m ()
emit RuntimeError p -> m ()
warn v
context =
(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
forall (m :: * -> *) p h.
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'
(\VarName
varName ->
GVal (Run p m h) -> Run p m h (GVal (Run p m h))
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
(VarName -> GVal (Run p m h)
forall (m :: * -> *) a. ToGVal m a => a -> GVal m
toGVal VarName
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
encode
Maybe (Newlines h)
forall h. ContextEncodable h => Maybe (Newlines h)
newlines
class ContextEncodable h where
encode :: forall m. GVal m -> h
newlines :: Maybe (Newlines h)
newlines = Maybe (Newlines h)
forall a. Maybe a
Nothing
instance ContextEncodable Text where
encode :: GVal m -> VarName
encode = GVal m -> VarName
forall (m :: * -> *). GVal m -> VarName
asText
newlines :: Maybe (Newlines VarName)
newlines = Newlines VarName -> Maybe (Newlines VarName)
forall a. a -> Maybe a
Just Newlines VarName
textNewlines
instance ContextEncodable Html where
encode :: 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
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' :: (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' VarName -> Run p m h (GVal (Run p m h))
lookupFn h -> m ()
writeFn GVal (Run p m h) -> h
encodeFn Maybe (Newlines h)
newlines =
(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
forall (m :: * -> *) p h.
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' VarName -> 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 (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' :: (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' VarName -> 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 :: forall p (m :: * -> *) h.
(VarName -> Run p m h (GVal (Run p m h)))
-> (h -> Run p m h ())
-> (RuntimeError p -> Run p m h ())
-> (GVal (Run p m h) -> h)
-> Maybe (Newlines h)
-> GingerContext p m h
GingerContext
{ contextLookup :: VarName -> Run p m h (GVal (Run p m h))
contextLookup = VarName -> 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 :: (VarName -> m v) -> VarName -> Run p m h (GVal (Run p m h))
liftLookup VarName -> m v
f VarName
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
$ VarName -> m v
f VarName
k
GVal (Run p m h) -> Run p m h (GVal (Run p m h))
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
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' :: (VarName -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' VarName -> GVal (Run p (Writer h) h)
lookupFn =
(VarName -> Run p (Writer h) h (GVal (Run p (Writer h) h)))
-> (h -> Writer h ())
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
forall (m :: * -> *) p h.
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'
(GVal (Run p (Writer h) h)
-> Run p (Writer h) h (GVal (Run p (Writer h) h))
forall (m :: * -> *) a. Monad m => a -> m a
return (GVal (Run p (Writer h) h)
-> Run p (Writer h) h (GVal (Run p (Writer h) h)))
-> (VarName -> GVal (Run p (Writer h) h))
-> VarName
-> Run p (Writer h) h (GVal (Run p (Writer h) h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> GVal (Run p (Writer h) 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 :: (VarName -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContext = (VarName -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
forall p.
(VarName -> 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 :: (VarName -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
makeContextM = (VarName -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
forall (m :: * -> *) p.
Monad m =>
(VarName -> 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 :: (VarName -> GVal (Run p (Writer Html) Html))
-> GingerContext p (Writer Html) Html
makeContextHtml VarName -> GVal (Run p (Writer Html) Html)
l = (VarName -> 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 =>
(VarName -> GVal (Run p (Writer h) h))
-> (GVal (Run p (Writer h) h) -> h)
-> Maybe (Newlines h)
-> GingerContext p (Writer h) h
makeContext' VarName -> 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 :: (VarName -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ()) -> GingerContext p m Html
makeContextHtmlM VarName -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w = (VarName -> 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 =>
(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' VarName -> 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 :: (VarName -> Run p m Html (GVal (Run p m Html)))
-> (Html -> m ())
-> (RuntimeError p -> m ())
-> GingerContext p m Html
makeContextHtmlExM VarName -> Run p m Html (GVal (Run p m Html))
l Html -> m ()
w RuntimeError p -> m ()
warn = (VarName -> 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 =>
(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' VarName -> 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 :: (VarName -> GVal (Run p (Writer VarName) VarName))
-> GingerContext p (Writer VarName) VarName
makeContextText VarName -> GVal (Run p (Writer VarName) VarName)
l = (VarName -> GVal (Run p (Writer VarName) VarName))
-> (GVal (Run p (Writer VarName) VarName) -> VarName)
-> Maybe (Newlines VarName)
-> GingerContext p (Writer VarName) VarName
forall h p.
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' VarName -> GVal (Run p (Writer VarName) VarName)
l GVal (Run p (Writer VarName) VarName) -> VarName
forall (m :: * -> *). GVal m -> VarName
asText (Newlines VarName -> Maybe (Newlines VarName)
forall a. a -> Maybe a
Just Newlines VarName
textNewlines)
makeContextTextM :: Monad m
=> (VarName -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ())
-> GingerContext p m Text
makeContextTextM :: (VarName -> Run p m VarName (GVal (Run p m VarName)))
-> (VarName -> m ()) -> GingerContext p m VarName
makeContextTextM VarName -> Run p m VarName (GVal (Run p m VarName))
l VarName -> m ()
w = (VarName -> Run p m VarName (GVal (Run p m VarName)))
-> (VarName -> m ())
-> (GVal (Run p m VarName) -> VarName)
-> Maybe (Newlines VarName)
-> GingerContext p m VarName
forall (m :: * -> *) p h.
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' VarName -> Run p m VarName (GVal (Run p m VarName))
l VarName -> m ()
w GVal (Run p m VarName) -> VarName
forall (m :: * -> *). GVal m -> VarName
asText (Newlines VarName -> Maybe (Newlines VarName)
forall a. a -> Maybe a
Just Newlines VarName
textNewlines)
makeContextTextExM :: Monad m
=> (VarName -> Run p m Text (GVal (Run p m Text)))
-> (Text -> m ())
-> (RuntimeError p -> m ())
-> GingerContext p m Text
makeContextTextExM :: (VarName -> Run p m VarName (GVal (Run p m VarName)))
-> (VarName -> m ())
-> (RuntimeError p -> m ())
-> GingerContext p m VarName
makeContextTextExM VarName -> Run p m VarName (GVal (Run p m VarName))
l VarName -> m ()
w RuntimeError p -> m ()
warn = (VarName -> Run p m VarName (GVal (Run p m VarName)))
-> (VarName -> m ())
-> (RuntimeError p -> m ())
-> (GVal (Run p m VarName) -> VarName)
-> Maybe (Newlines VarName)
-> GingerContext p m VarName
forall (m :: * -> *) p h.
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' VarName -> Run p m VarName (GVal (Run p m VarName))
l VarName -> m ()
w RuntimeError p -> m ()
warn GVal (Run p m VarName) -> VarName
forall (m :: * -> *). GVal m -> VarName
asText (Newlines VarName -> Maybe (Newlines VarName)
forall a. a -> Maybe a
Just Newlines VarName
textNewlines)
data Newlines h =
Newlines
{ Newlines h -> h -> [h]
splitLines :: h -> [h]
, Newlines h -> [h] -> h
joinLines :: [h] -> h
, Newlines h -> h -> h
stripIndent :: h -> h
, Newlines h -> h -> Bool
endsWithNewline :: h -> Bool
}
hoistNewlines :: (h -> t) -> (t -> h) -> Newlines h -> Newlines t
hoistNewlines :: (h -> t) -> (t -> h) -> Newlines h -> Newlines t
hoistNewlines h -> t
fwd t -> h
rev Newlines h
n =
Newlines :: forall h.
(h -> [h]) -> ([h] -> h) -> (h -> h) -> (h -> Bool) -> Newlines h
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 VarName
textNewlines =
Newlines :: forall h.
(h -> [h]) -> ([h] -> h) -> (h -> h) -> (h -> Bool) -> Newlines h
Newlines
{ splitLines :: VarName -> [VarName]
splitLines = [VarName] -> [VarName]
reNewline ([VarName] -> [VarName])
-> (VarName -> [VarName]) -> VarName -> [VarName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> VarName -> [VarName]
Text.splitOn VarName
"\n"
, joinLines :: [VarName] -> VarName
joinLines = [VarName] -> VarName
forall a. Monoid a => [a] -> a
mconcat
, stripIndent :: VarName -> VarName
stripIndent = VarName -> VarName
Text.stripStart
, endsWithNewline :: VarName -> Bool
endsWithNewline = (VarName
"\n" VarName -> VarName -> Bool
`Text.isSuffixOf`)
}
htmlNewlines :: Newlines Html
htmlNewlines :: Newlines Html
htmlNewlines =
Newlines :: forall h.
(h -> [h]) -> ([h] -> h) -> (h -> h) -> (h -> Bool) -> Newlines h
Newlines
{ splitLines :: Html -> [Html]
splitLines = (VarName -> Html) -> [VarName] -> [Html]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VarName -> Html
unsafeRawHtml ([VarName] -> [Html]) -> (Html -> [VarName]) -> Html -> [Html]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines VarName -> VarName -> [VarName]
forall h. Newlines h -> h -> [h]
splitLines Newlines VarName
textNewlines (VarName -> [VarName]) -> (Html -> VarName) -> Html -> [VarName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> VarName
htmlSource
, joinLines :: [Html] -> Html
joinLines = VarName -> Html
unsafeRawHtml (VarName -> Html) -> ([Html] -> VarName) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines VarName -> [VarName] -> VarName
forall h. Newlines h -> [h] -> h
joinLines Newlines VarName
textNewlines ([VarName] -> VarName)
-> ([Html] -> [VarName]) -> [Html] -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> VarName) -> [Html] -> [VarName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html -> VarName
htmlSource
, stripIndent :: Html -> Html
stripIndent = VarName -> Html
unsafeRawHtml (VarName -> Html) -> (Html -> VarName) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Newlines VarName -> VarName -> VarName
forall h. Newlines h -> h -> h
stripIndent Newlines VarName
textNewlines (VarName -> VarName) -> (Html -> VarName) -> Html -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> VarName
htmlSource
, endsWithNewline :: Html -> Bool
endsWithNewline = Newlines VarName -> VarName -> Bool
forall h. Newlines h -> h -> Bool
endsWithNewline Newlines VarName
textNewlines (VarName -> Bool) -> (Html -> VarName) -> Html -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> VarName
htmlSource
}
reNewline :: [Text] -> [Text]
reNewline :: [VarName] -> [VarName]
reNewline [] = []
reNewline (VarName
"":[]) = []
reNewline (VarName
x:[]) = [VarName
x]
reNewline (VarName
x:VarName
"":[]) = [VarName
x VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
"\n"]
reNewline (VarName
x:[VarName]
xs) = (VarName
x VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
"\n") VarName -> [VarName] -> [VarName]
forall a. a -> [a] -> [a]
: [VarName] -> [VarName]
reNewline [VarName]
xs
data RunState p m h
= RunState
{ :: HashMap VarName (GVal (Run p m h))
, RunState p m h -> h
rsCapture :: h
, RunState p m h -> Template p
rsCurrentTemplate :: Template p
, RunState p m h -> Maybe VarName
rsCurrentBlockName :: Maybe Text
, RunState p m h -> Maybe [h]
rsIndentation :: Maybe [h]
, RunState p m h -> Bool
rsAtLineStart :: Bool
, RunState p m h -> p
rsCurrentSourcePos :: p
}
hoistRunState :: Monad m => (h -> t) -> (t -> h) -> RunState p m h -> RunState p m t
hoistRunState :: (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 :: forall p (m :: * -> *) h.
HashMap VarName (GVal (Run p m h))
-> h
-> Template p
-> Maybe VarName
-> Maybe [h]
-> Bool
-> p
-> RunState p m h
RunState
{ rsScope :: HashMap VarName (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) -> 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) ((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) (GVal (Run p m h) -> GVal (Run p m t))
-> HashMap VarName (GVal (Run p m h))
-> HashMap VarName (GVal (Run p m t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunState p m h -> HashMap VarName (GVal (Run p m h))
forall p (m :: * -> *) h.
RunState p m h -> HashMap VarName (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 VarName
rsCurrentBlockName = RunState p m h -> Maybe VarName
forall p (m :: * -> *) h. RunState p m h -> Maybe VarName
rsCurrentBlockName RunState p m h
rs
, rsIndentation :: Maybe [t]
rsIndentation = (h -> t) -> [h] -> [t]
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
| UndefinedBlockError Text
| ArgumentsError (Maybe Text) Text
| TypeError [Text] (Maybe Text)
| 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
showList :: [RuntimeError p] -> ShowS
$cshowList :: forall p. Show p => [RuntimeError p] -> ShowS
show :: RuntimeError p -> String
$cshow :: forall p. Show p => RuntimeError p -> String
showsPrec :: Int -> RuntimeError p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> RuntimeError p -> ShowS
Show)
instance Default (RuntimeError p) where
def :: RuntimeError p
def = VarName -> RuntimeError p
forall p. VarName -> RuntimeError p
RuntimeError VarName
""
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 :: RuntimeError p -> VarName
runtimeErrorWhat (ArgumentsError Maybe VarName
funcName VarName
explanation) = VarName
"ArgumentsError"
runtimeErrorWhat (EvalParseError ParserError
e) = VarName
"EvalParseError"
runtimeErrorWhat (RuntimeError VarName
msg) = VarName
"RuntimeError"
runtimeErrorWhat (UndefinedBlockError VarName
blockName) = VarName
"UndefinedBlockError"
runtimeErrorWhat RuntimeError p
NotAFunctionError = VarName
"NotAFunctionError"
runtimeErrorWhat (IndexError VarName
_) = VarName
"IndexError"
runtimeErrorWhat (TypeError [VarName]
_ Maybe VarName
_) = VarName
"TypeError"
runtimeErrorWhat (RuntimeErrorAt p
_ RuntimeError p
e) = RuntimeError p -> VarName
forall p. RuntimeError p -> VarName
runtimeErrorWhat RuntimeError p
e
runtimeErrorMessage :: RuntimeError p -> Text
runtimeErrorMessage :: RuntimeError p -> VarName
runtimeErrorMessage (ArgumentsError Maybe VarName
Nothing VarName
explanation) =
VarName
"invalid arguments: " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
explanation
runtimeErrorMessage (ArgumentsError (Just VarName
funcName) VarName
explanation) =
VarName
"invalid arguments to function '" VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
funcName VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
"': " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
explanation
runtimeErrorMessage (TypeError [VarName]
expected Maybe VarName
actual) =
VarName
"wrong type"
VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> case [VarName]
expected of
[] -> VarName
""
[VarName
x] -> VarName
", expected " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
x
[VarName]
xs -> VarName
", expected " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> ([VarName] -> VarName
forall a. Monoid a => [a] -> a
mconcat ([VarName] -> VarName)
-> ([VarName] -> [VarName]) -> [VarName] -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> [VarName] -> [VarName]
forall a. a -> [a] -> [a]
List.intersperse VarName
" or " ([VarName] -> VarName) -> [VarName] -> VarName
forall a b. (a -> b) -> a -> b
$ [VarName]
xs)
VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> case Maybe VarName
actual of
Maybe VarName
Nothing -> VarName
""
Just VarName
x -> VarName
", found " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
x
runtimeErrorMessage (IndexError VarName
i) =
VarName
"invalid index " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
i
runtimeErrorMessage (EvalParseError ParserError
e) =
VarName
"parser error in eval()-ed code: " VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> String -> VarName
Text.pack (ParserError -> String
peErrorMessage ParserError
e)
runtimeErrorMessage (RuntimeError VarName
msg) =
VarName
msg
runtimeErrorMessage (UndefinedBlockError VarName
blockName) =
VarName
"undefined block: '" VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
blockName VarName -> VarName -> VarName
forall a. Semigroup a => a -> a -> a
<> VarName
"'"
runtimeErrorMessage RuntimeError p
NotAFunctionError =
VarName
"attempted to call something that is not a function"
runtimeErrorMessage (RuntimeErrorAt p
_ RuntimeError p
e) =
RuntimeError p -> VarName
forall p. RuntimeError p -> VarName
runtimeErrorMessage RuntimeError p
e
runtimeErrorWhere :: RuntimeError p -> [p]
runtimeErrorWhere :: 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 :: RuntimeError p -> GVal m
runtimeErrorToGVal RuntimeError p
e =
let ([p]
callStack, [(VarName, GVal m)]
props) = RuntimeError p -> ([p], [(VarName, GVal m)])
forall p (m :: * -> *).
RuntimeError p -> ([p], [(VarName, GVal m)])
runtimeErrorToGValRaw RuntimeError p
e
props' :: [Pair m]
props' = ((VarName
"callStack" :: Text) VarName -> [p] -> Pair m
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> [p]
callStack)Pair m -> [Pair m] -> [Pair m]
forall a. a -> [a] -> [a]
:[Pair m]
forall (m :: * -> *). [(VarName, GVal m)]
props
in ([Pair m] -> GVal m
forall (m :: * -> *). [Pair m] -> GVal m
dict [Pair m]
props') { asText :: VarName
asText = RuntimeError p -> VarName
forall p. RuntimeError p -> VarName
runtimeErrorMessage RuntimeError p
e }
runtimeErrorToGValRaw :: RuntimeError p -> ([p], [(Text, GVal m)])
runtimeErrorToGValRaw :: RuntimeError p -> ([p], [(VarName, GVal m)])
runtimeErrorToGValRaw (RuntimeError VarName
msg) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"RuntimeError" []
)
runtimeErrorToGValRaw (UndefinedBlockError VarName
blockName) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"UndefinedBlockError"
[ VarName
"block" VarName -> VarName -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> VarName
blockName
]
)
runtimeErrorToGValRaw (ArgumentsError Maybe VarName
funcName VarName
explanation) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"ArgumentsError"
[ VarName
"explanation" VarName -> VarName -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> VarName
explanation
, VarName
"function" VarName -> Maybe VarName -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> Maybe VarName
funcName
]
)
runtimeErrorToGValRaw (TypeError [VarName]
expected Maybe VarName
Nothing) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"ArgumentsError"
[ VarName
"expected" VarName -> [VarName] -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> [VarName]
expected
]
)
runtimeErrorToGValRaw (TypeError [VarName]
expected (Just VarName
actual)) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"ArgumentsError"
[ VarName
"expected" VarName -> [VarName] -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> [VarName]
expected
, VarName
"actual" VarName -> VarName -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> VarName
actual
]
)
runtimeErrorToGValRaw (EvalParseError ParserError
e) =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"EvalParseError"
[ VarName
"errorMessage" VarName -> String -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> ParserError -> String
peErrorMessage ParserError
e
]
)
runtimeErrorToGValRaw RuntimeError p
NotAFunctionError =
( []
, VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall (m :: * -> *).
VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
"NotAFunctionError"
[]
)
runtimeErrorToGValRaw (RuntimeErrorAt p
p RuntimeError p
e) =
let ([p]
callStack, [(VarName, GVal m)]
inner) = RuntimeError p -> ([p], [(VarName, GVal m)])
forall p (m :: * -> *).
RuntimeError p -> ([p], [(VarName, GVal m)])
runtimeErrorToGValRaw RuntimeError p
e
in (p
pp -> [p] -> [p]
forall a. a -> [a] -> [a]
:[p]
callStack, [(VarName, GVal m)]
forall (m :: * -> *). [(VarName, GVal m)]
inner)
rteGVal :: Text -> [(Text, GVal m)] -> [(Text, GVal m)]
rteGVal :: VarName -> [(VarName, GVal m)] -> [(VarName, GVal m)]
rteGVal VarName
what [(VarName, GVal m)]
extra =
( [ VarName
"what" VarName -> VarName -> (VarName, GVal m)
forall (m :: * -> *) a. ToGVal m a => VarName -> a -> Pair m
~> VarName
what
]
[(VarName, GVal m)] -> [(VarName, GVal m)] -> [(VarName, GVal m)]
forall a. [a] -> [a] -> [a]
++ [(VarName, GVal m)]
extra
)
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
liftRun :: m a -> Run p m h a
liftRun = StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a
-> Run p m h 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
-> Run p m h a)
-> (m a
-> StateT (RunState p m h) (ReaderT (GingerContext p m h) m) a)
-> m a
-> Run p m h 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 (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 (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
liftRun2 :: Monad m => (a -> m b) -> a -> Run p m h b
liftRun2 :: (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
hoistRun :: Monad m => (h -> t) -> (t -> h) -> Run p m h a -> Run p m t a
hoistRun :: (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 (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 (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 (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 e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> Run p m t 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 :: 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 :: 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 () -> Run p m h a -> Run p m h a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Run p m h a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
warnFromMaybe RuntimeError p
_ a
d (Just a
x) = a -> Run p m h a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
setSourcePos :: Monad m
=> p
-> Run p m h ()
setSourcePos :: p -> Run p m h ()
setSourcePos p
pos =
(RunState p m h -> RunState p m h) -> Run p m h ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\RunState p m h
s -> RunState p m h
s { rsCurrentSourcePos :: p
rsCurrentSourcePos = p
pos })
getSourcePos :: Monad m
=> Run p m h p
getSourcePos :: Run p m h p
getSourcePos = (RunState p m h -> p) -> Run p m h 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 :: 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 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 :: Monad m
=> p
-> Run p m h a
-> Run p m h a
withSourcePos :: 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 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 (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 (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 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)