{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Sindre.Compiler (
compileSindre,
ClassMap,
ObjectMap,
FuncMap,
GlobMap,
Constructor,
ConstructorM,
Param(..),
paramM,
paramAs,
param,
noParam,
badValue,
Compiler,
value,
setValue,
)
where
import Sindre.Runtime
import Sindre.Sindre
import Sindre.Util
import System.Exit
import Control.Applicative
import Control.Monad.Error
import Control.Monad.RWS.Lazy
import Control.Monad.State
import Data.Array
import Data.Fixed
import Data.List
import Data.Maybe
import Data.Traversable (for, traverse)
import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.Text as T
compileSindre :: MonadBackend m => Program
-> ClassMap m -> ObjectMap m -> FuncMap m -> GlobMap m
-> ([SindreOption], Arguments -> m ExitCode)
compileSindre :: Program
-> ClassMap m
-> ObjectMap m
-> FuncMap m
-> GlobMap m
-> ([SindreOption], Arguments -> m ExitCode)
compileSindre Program
prog ClassMap m
cm ObjectMap m
om FuncMap m
fm GlobMap m
gm = ([SindreOption]
opts, Arguments -> m ExitCode
start)
where ([SindreOption]
opts, Sindre m ()
prog', WidgetRef
rootw) = Program
-> ClassMap m
-> ObjectMap m
-> FuncMap m
-> GlobMap m
-> ([SindreOption], Sindre m (), WidgetRef)
forall (m :: * -> *).
MonadBackend m =>
Program
-> ClassMap m
-> ObjectMap m
-> FuncMap m
-> GlobMap m
-> ([SindreOption], Sindre m (), WidgetRef)
compileProgram Program
prog ClassMap m
cm ObjectMap m
om FuncMap m
fm GlobMap m
gm
start :: Arguments -> m ExitCode
start Arguments
argv =
let env :: SindreEnv m
env = WidgetRef -> Arguments -> SindreEnv m
forall (m :: * -> *). WidgetRef -> Arguments -> SindreEnv m
newEnv WidgetRef
rootw Arguments
argv
in SindreEnv m -> Sindre m () -> m ExitCode
forall (m :: * -> *) a.
MonadBackend m =>
SindreEnv m -> Sindre m a -> m ExitCode
execSindre SindreEnv m
forall (m :: * -> *). SindreEnv m
env Sindre m ()
prog'
data Binding = Lexical IM.Key | Global GlobalBinding
data GlobalBinding = Constant Value | Mutable IM.Key
type ClassMap m = M.Map Identifier (Constructor m)
type ObjectMap m = M.Map Identifier (ObjectRef -> m (NewObject m))
type FuncMap m = M.Map Identifier (Compiler m ([Value] -> Sindre m Value))
type GlobMap m = M.Map Identifier (m Value)
data CompilerEnv m = CompilerEnv {
CompilerEnv m -> Map Identifier Key
lexicalScope :: M.Map Identifier IM.Key
, CompilerEnv m -> Map Identifier (Execution m Value)
functionRefs :: M.Map Identifier (Execution m Value)
, CompilerEnv m -> SourcePos
currentPos :: SourcePos
}
blankCompilerEnv :: CompilerEnv m
blankCompilerEnv :: CompilerEnv m
blankCompilerEnv = CompilerEnv :: forall (m :: * -> *).
Map Identifier Key
-> Map Identifier (Execution m Value) -> SourcePos -> CompilerEnv m
CompilerEnv {
lexicalScope :: Map Identifier Key
lexicalScope = Map Identifier Key
forall k a. Map k a
M.empty
, functionRefs :: Map Identifier (Execution m Value)
functionRefs = Map Identifier (Execution m Value)
forall k a. Map k a
M.empty
, currentPos :: SourcePos
currentPos = SourcePos
nowhere
}
data CompilerState = CompilerState {
CompilerState -> Map Identifier GlobalBinding
globalScope :: M.Map Identifier GlobalBinding
, CompilerState -> Key
nextMutable :: IM.Key
}
blankCompilerState :: CompilerState
blankCompilerState :: CompilerState
blankCompilerState = CompilerState :: Map Identifier GlobalBinding -> Key -> CompilerState
CompilerState {
globalScope :: Map Identifier GlobalBinding
globalScope = Map Identifier GlobalBinding
forall k a. Map k a
M.empty
, nextMutable :: Key
nextMutable = Key
0
}
type Initialisation m = Sindre m ()
type Compiler m a = RWS (CompilerEnv m) (Initialisation m) CompilerState a
runCompiler :: CompilerEnv m -> Compiler m a -> (a, Initialisation m)
runCompiler :: CompilerEnv m -> Compiler m a -> (a, Initialisation m)
runCompiler CompilerEnv m
env Compiler m a
m = Compiler m a
-> CompilerEnv m -> CompilerState -> (a, Initialisation m)
forall r w s a. RWS r w s a -> r -> s -> (a, w)
evalRWS Compiler m a
m CompilerEnv m
env CompilerState
blankCompilerState
descend :: (a -> Compiler m b) -> P a -> Compiler m b
descend :: (a -> Compiler m b) -> P a -> Compiler m b
descend a -> Compiler m b
m (P SourcePos
p a
v) = (CompilerEnv m -> CompilerEnv m) -> Compiler m b -> Compiler m b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CompilerEnv m
s -> CompilerEnv m
s { currentPos :: SourcePos
currentPos = SourcePos
p }) (Compiler m b -> Compiler m b) -> Compiler m b -> Compiler m b
forall a b. (a -> b) -> a -> b
$ a -> Compiler m b
m a
v
compileError :: String -> Compiler m a
compileError :: Identifier -> Compiler m a
compileError Identifier
s = do Identifier
pos <- SourcePos -> Identifier
position (SourcePos -> Identifier)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity SourcePos
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompilerEnv m -> SourcePos)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity SourcePos
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompilerEnv m -> SourcePos
forall (m :: * -> *). CompilerEnv m -> SourcePos
currentPos
Identifier -> Compiler m a
forall a. HasCallStack => Identifier -> a
error (Identifier -> Compiler m a) -> Identifier -> Compiler m a
forall a b. (a -> b) -> a -> b
$ Identifier
pos Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
s
runtimeError :: MonadFail m => Compiler m (String -> Execution m a)
runtimeError :: Compiler m (Identifier -> Execution m a)
runtimeError = do Identifier
pos <- SourcePos -> Identifier
position (SourcePos -> Identifier)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity SourcePos
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompilerEnv m -> SourcePos)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity SourcePos
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompilerEnv m -> SourcePos
forall (m :: * -> *). CompilerEnv m -> SourcePos
currentPos
(Identifier -> Execution m a)
-> Compiler m (Identifier -> Execution m a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Identifier -> Execution m a)
-> Compiler m (Identifier -> Execution m a))
-> (Identifier -> Execution m a)
-> Compiler m (Identifier -> Execution m a)
forall a b. (a -> b) -> a -> b
$ \Identifier
s -> Identifier -> Execution m a
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> Execution m a) -> Identifier -> Execution m a
forall a b. (a -> b) -> a -> b
$ Identifier
pos Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
s
function :: MonadBackend m => Identifier -> Compiler m (Execution m Value)
function :: Identifier -> Compiler m (Execution m Value)
function Identifier
k = Compiler m (Execution m Value)
-> (Execution m Value -> Compiler m (Execution m Value))
-> Maybe (Execution m Value)
-> Compiler m (Execution m Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Compiler m (Execution m Value)
forall (m :: * -> *) a. Compiler m a
bad Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Execution m Value) -> Compiler m (Execution m Value))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value))
-> Compiler m (Execution m Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Identifier
-> Map Identifier (Execution m Value) -> Maybe (Execution m Value)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k (Map Identifier (Execution m Value) -> Maybe (Execution m Value))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier (Execution m Value))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompilerEnv m -> Map Identifier (Execution m Value))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier (Execution m Value))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompilerEnv m -> Map Identifier (Execution m Value)
forall (m :: * -> *).
CompilerEnv m -> Map Identifier (Execution m Value)
functionRefs
where bad :: Compiler m a
bad = Identifier -> Compiler m a
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier -> Compiler m a) -> Identifier -> Compiler m a
forall a b. (a -> b) -> a -> b
$ Identifier
"Unknown function '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
defName :: MonadBackend m =>
Identifier -> GlobalBinding -> Compiler m ()
defName :: Identifier -> GlobalBinding -> Compiler m ()
defName Identifier
k GlobalBinding
b = do
Maybe GlobalBinding
known <- Identifier -> Map Identifier GlobalBinding -> Maybe GlobalBinding
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k (Map Identifier GlobalBinding -> Maybe GlobalBinding)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier GlobalBinding)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe GlobalBinding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompilerState -> Map Identifier GlobalBinding)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier GlobalBinding)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompilerState -> Map Identifier GlobalBinding
globalScope
case Maybe GlobalBinding
known of
Just GlobalBinding
_ -> Identifier -> Compiler m ()
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier -> Compiler m ()) -> Identifier -> Compiler m ()
forall a b. (a -> b) -> a -> b
$ Identifier
"Multiple definitions of '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
Maybe GlobalBinding
Nothing -> (CompilerState -> CompilerState) -> Compiler m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompilerState -> CompilerState) -> Compiler m ())
-> (CompilerState -> CompilerState) -> Compiler m ()
forall a b. (a -> b) -> a -> b
$ \CompilerState
s -> CompilerState
s
{ globalScope :: Map Identifier GlobalBinding
globalScope = Identifier
-> GlobalBinding
-> Map Identifier GlobalBinding
-> Map Identifier GlobalBinding
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
k GlobalBinding
b (Map Identifier GlobalBinding -> Map Identifier GlobalBinding)
-> Map Identifier GlobalBinding -> Map Identifier GlobalBinding
forall a b. (a -> b) -> a -> b
$ CompilerState -> Map Identifier GlobalBinding
globalScope CompilerState
s }
defMutable :: MonadBackend m => Identifier -> Compiler m IM.Key
defMutable :: Identifier -> Compiler m Key
defMutable Identifier
k = do
Key
i <- (CompilerState -> Key) -> Compiler m Key
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompilerState -> Key
nextMutable
(CompilerState -> CompilerState)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((CompilerState -> CompilerState)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ())
-> (CompilerState -> CompilerState)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ \CompilerState
s -> CompilerState
s { nextMutable :: Key
nextMutable = Key
i Key -> Key -> Key
forall a. Num a => a -> a -> a
+ Key
1 }
Identifier
-> GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall (m :: * -> *).
MonadBackend m =>
Identifier -> GlobalBinding -> Compiler m ()
defName Identifier
k (GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ())
-> GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ Key -> GlobalBinding
Mutable Key
i
Key -> Compiler m Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
i
constant :: MonadBackend m => Identifier -> Compiler m Value
constant :: Identifier -> Compiler m Value
constant Identifier
k = do
Map Identifier GlobalBinding
global <- (CompilerState -> Map Identifier GlobalBinding)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier GlobalBinding)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompilerState -> Map Identifier GlobalBinding
globalScope
case Identifier -> Map Identifier GlobalBinding -> Maybe GlobalBinding
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k Map Identifier GlobalBinding
global of
Just (Constant Value
v) -> Value -> Compiler m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
Maybe GlobalBinding
_ -> Identifier -> Compiler m Value
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier -> Compiler m Value) -> Identifier -> Compiler m Value
forall a b. (a -> b) -> a -> b
$ Identifier
"Unknown constant '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
binding :: MonadBackend m => Identifier -> Compiler m Binding
binding :: Identifier -> Compiler m Binding
binding Identifier
k = do
Map Identifier Key
lexical <- (CompilerEnv m -> Map Identifier Key)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier Key)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks CompilerEnv m -> Map Identifier Key
forall (m :: * -> *). CompilerEnv m -> Map Identifier Key
lexicalScope
Map Identifier GlobalBinding
global <- (CompilerState -> Map Identifier GlobalBinding)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier GlobalBinding)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets CompilerState -> Map Identifier GlobalBinding
globalScope
case Identifier -> Map Identifier Key -> Maybe Key
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k Map Identifier Key
lexical of
Just Key
b -> Binding -> Compiler m Binding
forall (m :: * -> *) a. Monad m => a -> m a
return (Binding -> Compiler m Binding) -> Binding -> Compiler m Binding
forall a b. (a -> b) -> a -> b
$ Key -> Binding
Lexical Key
b
Maybe Key
Nothing -> case Identifier -> Map Identifier GlobalBinding -> Maybe GlobalBinding
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k Map Identifier GlobalBinding
global of
Just GlobalBinding
b -> Binding -> Compiler m Binding
forall (m :: * -> *) a. Monad m => a -> m a
return (Binding -> Compiler m Binding) -> Binding -> Compiler m Binding
forall a b. (a -> b) -> a -> b
$ GlobalBinding -> Binding
Global GlobalBinding
b
Maybe GlobalBinding
Nothing -> GlobalBinding -> Binding
Global (GlobalBinding -> Binding)
-> (Key -> GlobalBinding) -> Key -> Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key -> GlobalBinding
Mutable (Key -> Binding)
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity Key
-> Compiler m Binding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity Key
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Key
defMutable Identifier
k
value :: MonadBackend m => Identifier -> Compiler m (Execution m Value)
value :: Identifier -> Compiler m (Execution m Value)
value Identifier
k = do
Binding
bnd <- Identifier -> Compiler m Binding
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Binding
binding Identifier
k
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ case Binding
bnd of
Lexical Key
k' -> Key -> Execution m Value
forall (m :: * -> *). MonadBackend m => Key -> Execution m Value
lexicalVal Key
k'
Global (Mutable Key
k') -> Sindre m Value -> Execution m Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m Value -> Execution m Value)
-> Sindre m Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Key -> Sindre m Value
forall (m :: * -> *). MonadBackend m => Key -> Sindre m Value
globalVal Key
k'
Global (Constant Value
v) -> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
setValue :: MonadBackend m => Identifier -> Compiler m (Value -> Execution m ())
setValue :: Identifier -> Compiler m (Value -> Execution m ())
setValue Identifier
k = do
Binding
bnd <- Identifier -> Compiler m Binding
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Binding
binding Identifier
k
case Binding
bnd of
Lexical Key
k' -> (Value -> Execution m ()) -> Compiler m (Value -> Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value -> Execution m ()) -> Compiler m (Value -> Execution m ()))
-> (Value -> Execution m ())
-> Compiler m (Value -> Execution m ())
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Key -> Value -> Execution m ()
setLexical Key
k'
Global (Mutable Key
k') -> (Value -> Execution m ()) -> Compiler m (Value -> Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Value -> Execution m ()) -> Compiler m (Value -> Execution m ()))
-> (Value -> Execution m ())
-> Compiler m (Value -> Execution m ())
forall a b. (a -> b) -> a -> b
$ Sindre m () -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m () -> Execution m ())
-> (Value -> Sindre m ()) -> Value -> Execution m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Value -> Sindre m ()
forall (m :: * -> *). MonadBackend m => Key -> Value -> Sindre m ()
setGlobal Key
k'
Global GlobalBinding
_ -> Identifier -> Compiler m (Value -> Execution m ())
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier -> Compiler m (Value -> Execution m ()))
-> Identifier -> Compiler m (Value -> Execution m ())
forall a b. (a -> b) -> a -> b
$ Identifier
"Cannot reassign constant '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
compileBackendGlobal :: MonadBackend m => (Identifier, m Value) -> Compiler m ()
compileBackendGlobal :: (Identifier, m Value) -> Compiler m ()
compileBackendGlobal (Identifier
k, m Value
v) = do
Key
k' <- Identifier -> Compiler m Key
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Key
defMutable Identifier
k
Sindre m () -> Compiler m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Sindre m () -> Compiler m ()) -> Sindre m () -> Compiler m ()
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Sindre m ()
forall (m :: * -> *). MonadBackend m => Key -> Value -> Sindre m ()
setGlobal Key
k' (Value -> Sindre m ()) -> Sindre m Value -> Sindre m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Value -> Sindre m Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back m Value
v
compileGlobal :: MonadBackend m =>
(Identifier, P Expr) -> Compiler m ()
compileGlobal :: (Identifier, P Expr) -> Compiler m ()
compileGlobal (Identifier
k, P Expr
e) = do
Key
k' <- Identifier -> Compiler m Key
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Key
defMutable Identifier
k
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Sindre m () -> Compiler m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Sindre m () -> Compiler m ()) -> Sindre m () -> Compiler m ()
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Sindre m ()
forall (m :: * -> *). MonadBackend m => Key -> Value -> Sindre m ()
setGlobal Key
k' (Value -> Sindre m ()) -> Sindre m Value -> Sindre m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute Execution m Value
e'
compileOption :: MonadBackend m =>
(Identifier, (SindreOption, Maybe Value))
-> Compiler m SindreOption
compileOption :: (Identifier, (SindreOption, Maybe Value))
-> Compiler m SindreOption
compileOption (Identifier
k, (SindreOption
opt, Maybe Value
def)) = do
let defval :: Value
defval = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
falsity Maybe Value
def
Key
k' <- Identifier -> Compiler m Key
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Key
defMutable Identifier
k
Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ do
Maybe Identifier
v <- Identifier -> Arguments -> Maybe Identifier
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k (Arguments -> Maybe Identifier)
-> Sindre m Arguments -> Sindre m (Maybe Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SindreEnv m -> Arguments) -> Sindre m Arguments
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv m -> Arguments
forall (m :: * -> *). SindreEnv m -> Arguments
arguments
Key -> Value -> Sindre m ()
forall (m :: * -> *). MonadBackend m => Key -> Value -> Sindre m ()
setGlobal Key
k' (Value -> Sindre m ()) -> Value -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ Value -> (Identifier -> Value) -> Maybe Identifier -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
defval Identifier -> Value
string Maybe Identifier
v
SindreOption -> Compiler m SindreOption
forall (m :: * -> *) a. Monad m => a -> m a
return SindreOption
opt
compileObjs :: MonadBackend m =>
ObjectNum -> ObjectMap m ->
Compiler m (InstObjs m)
compileObjs :: Key -> ObjectMap m -> Compiler m (InstObjs m)
compileObjs Key
r = (Key
-> (Identifier, WidgetRef -> m (NewObject m))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
((Identifier, WidgetRef), WidgetRef -> m (NewObject m)))
-> [Key]
-> [(Identifier, WidgetRef -> m (NewObject m))]
-> Compiler m (InstObjs m)
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Key
-> (Identifier, WidgetRef -> m (NewObject m))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
((Identifier, WidgetRef), WidgetRef -> m (NewObject m))
forall (m :: * -> *) b.
MonadBackend m =>
Key
-> (Identifier, b)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
((Identifier, WidgetRef), b)
inst [Key
r..] ([(Identifier, WidgetRef -> m (NewObject m))]
-> Compiler m (InstObjs m))
-> (ObjectMap m -> [(Identifier, WidgetRef -> m (NewObject m))])
-> ObjectMap m
-> Compiler m (InstObjs m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectMap m -> [(Identifier, WidgetRef -> m (NewObject m))]
forall k a. Map k a -> [(k, a)]
M.toList
where inst :: Key
-> (Identifier, b)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
((Identifier, WidgetRef), b)
inst Key
r' (Identifier
k, b
f) = do
let ref :: WidgetRef
ref = (Key
r', Identifier
k, Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
k)
Identifier -> GlobalBinding -> Compiler m ()
forall (m :: * -> *).
MonadBackend m =>
Identifier -> GlobalBinding -> Compiler m ()
defName Identifier
k (GlobalBinding -> Compiler m ()) -> GlobalBinding -> Compiler m ()
forall a b. (a -> b) -> a -> b
$ Value -> GlobalBinding
Constant (Value -> GlobalBinding) -> Value -> GlobalBinding
forall a b. (a -> b) -> a -> b
$ WidgetRef -> Value
Reference WidgetRef
ref
((Identifier, WidgetRef), b)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
((Identifier, WidgetRef), b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Identifier
k, WidgetRef
ref), b
f)
compileGUI :: MonadBackend m => ClassMap m -> (Maybe (P Expr), GUI)
-> Compiler m (ObjectNum, InstGUI m)
compileGUI :: ClassMap m -> (Maybe (P Expr), GUI) -> Compiler m (Key, InstGUI m)
compileGUI ClassMap m
m (Maybe (P Expr)
pos, GUI
gui) = do
case Maybe (P Expr)
pos of
Maybe (P Expr)
Nothing -> ()
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just P Expr
re -> do Execution m Value
re' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
re
Initialisation m
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Initialisation m
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ())
-> Initialisation m
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ Value -> Initialisation m
forall (m :: * -> *). MonadBackend m => Value -> Sindre m ()
setRootPosition (Value -> Initialisation m) -> Sindre m Value -> Initialisation m
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute Execution m Value
re'
Key -> GUI -> Compiler m (Key, InstGUI m)
inst Key
0 GUI
gui
where inst :: Key -> GUI -> Compiler m (Key, InstGUI m)
inst Key
r (GUI Maybe Identifier
k P Identifier
c WidgetArgs
es [(Maybe (P Expr), GUI)]
cs) = do
Map Identifier (Execution m Value)
es' <- (P Expr -> Compiler m (Execution m Value))
-> WidgetArgs
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Map Identifier (Execution m Value))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr) WidgetArgs
es
(Key
lastwr, [InstGUI m]
children) <-
(Key -> GUI -> Compiler m (Key, InstGUI m))
-> Key
-> [GUI]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Key, [InstGUI m])
forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM (Key -> GUI -> Compiler m (Key, InstGUI m)
inst (Key -> GUI -> Compiler m (Key, InstGUI m))
-> (Key -> Key) -> Key -> GUI -> Compiler m (Key, InstGUI m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> Key -> Key
forall a. Num a => a -> a -> a
+Key
1)) (Key
rKey -> Key -> Key
forall a. Num a => a -> a -> a
+[(Maybe (P Expr), GUI)] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length [(Maybe (P Expr), GUI)]
cs) [GUI]
childwrs
case Maybe Identifier
k of
Just Identifier
k' -> Identifier
-> GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall (m :: * -> *).
MonadBackend m =>
Identifier -> GlobalBinding -> Compiler m ()
defName Identifier
k' (GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ())
-> GlobalBinding
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ Value -> GlobalBinding
Constant (Value -> GlobalBinding) -> Value -> GlobalBinding
forall a b. (a -> b) -> a -> b
$ WidgetRef -> Value
Reference (Key
lastwr, P Identifier -> Identifier
forall a. P a -> a
unP P Identifier
c, Maybe Identifier
k)
Maybe Identifier
Nothing -> ()
-> RWST
(CompilerEnv m) (Initialisation m) CompilerState Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Constructor m
c' <- (Identifier -> Compiler m (Constructor m))
-> P Identifier -> Compiler m (Constructor m)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend (ClassMap m -> Identifier -> Compiler m (Constructor m)
forall (m :: * -> *).
ClassMap m -> Identifier -> Compiler m (Constructor m)
lookupClass ClassMap m
m) P Identifier
c
[Maybe (Execution m Value)]
orients' <- [Maybe (P Expr)]
-> (Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value)))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Maybe (Execution m Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Maybe (P Expr)]
orients ((Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value)))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Maybe (Execution m Value)])
-> (Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value)))
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Maybe (Execution m Value)]
forall a b. (a -> b) -> a -> b
$ (P Expr -> Compiler m (Execution m Value))
-> Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((P Expr -> Compiler m (Execution m Value))
-> Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value)))
-> (P Expr -> Compiler m (Execution m Value))
-> Maybe (P Expr)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Maybe (Execution m Value))
forall a b. (a -> b) -> a -> b
$ (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr
(Key, InstGUI m) -> Compiler m (Key, InstGUI m)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Key
lastwr, WidgetRef
-> Constructor m
-> Map Identifier (Execution m Value)
-> [(Maybe (Execution m Value), InstGUI m)]
-> InstGUI m
forall (m :: * -> *).
WidgetRef
-> Constructor m
-> WidgetArgs m
-> [(Maybe (Execution m Value), InstGUI m)]
-> InstGUI m
InstGUI (Key
r, P Identifier -> Identifier
forall a. P a -> a
unP P Identifier
c, Maybe Identifier
k) Constructor m
c' Map Identifier (Execution m Value)
es'
([(Maybe (Execution m Value), InstGUI m)] -> InstGUI m)
-> [(Maybe (Execution m Value), InstGUI m)] -> InstGUI m
forall a b. (a -> b) -> a -> b
$ [Maybe (Execution m Value)]
-> [InstGUI m] -> [(Maybe (Execution m Value), InstGUI m)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe (Execution m Value)]
orients' [InstGUI m]
children )
where ([Maybe (P Expr)]
orients, [GUI]
childwrs) = [(Maybe (P Expr), GUI)] -> ([Maybe (P Expr)], [GUI])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Maybe (P Expr), GUI)]
cs
compileProgram :: MonadBackend m => Program ->
ClassMap m -> ObjectMap m -> FuncMap m -> GlobMap m
-> ([SindreOption], Sindre m () , WidgetRef)
compileProgram :: Program
-> ClassMap m
-> ObjectMap m
-> FuncMap m
-> GlobMap m
-> ([SindreOption], Sindre m (), WidgetRef)
compileProgram Program
prog ClassMap m
cm ObjectMap m
om FuncMap m
fm GlobMap m
gm =
let env :: CompilerEnv m
env = CompilerEnv Any
forall (m :: * -> *). CompilerEnv m
blankCompilerEnv { functionRefs :: Map Identifier (Execution m Value)
functionRefs = Map Identifier (Execution m Value)
funtable }
((Map Identifier (Execution m Value)
funtable, EventHandler m
evhandler, [SindreOption]
options, WidgetRef
rootw), Sindre m ()
initialiser) =
CompilerEnv m
-> Compiler
m
(Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef)
-> ((Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef),
Sindre m ())
forall (m :: * -> *) a.
CompilerEnv m -> Compiler m a -> (a, Initialisation m)
runCompiler CompilerEnv m
env (Compiler
m
(Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef)
-> ((Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef),
Sindre m ()))
-> Compiler
m
(Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef)
-> ((Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef),
Sindre m ())
forall a b. (a -> b) -> a -> b
$ do
((Identifier, m Value)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> [(Identifier, m Value)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Identifier, m Value)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall (m :: * -> *).
MonadBackend m =>
(Identifier, m Value) -> Compiler m ()
compileBackendGlobal ([(Identifier, m Value)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> [(Identifier, m Value)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ GlobMap m -> [(Identifier, m Value)]
forall k a. Map k a -> [(k, a)]
M.toList GlobMap m
gm
[SindreOption]
opts <- (P (Identifier, (SindreOption, Maybe Value))
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity SindreOption)
-> [P (Identifier, (SindreOption, Maybe Value))]
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity [SindreOption]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Identifier, (SindreOption, Maybe Value))
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity SindreOption)
-> P (Identifier, (SindreOption, Maybe Value))
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity SindreOption
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend (Identifier, (SindreOption, Maybe Value))
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity SindreOption
forall (m :: * -> *).
MonadBackend m =>
(Identifier, (SindreOption, Maybe Value))
-> Compiler m SindreOption
compileOption) ([P (Identifier, (SindreOption, Maybe Value))]
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[SindreOption])
-> [P (Identifier, (SindreOption, Maybe Value))]
-> RWST
(CompilerEnv m) (Sindre m ()) CompilerState Identity [SindreOption]
forall a b. (a -> b) -> a -> b
$ Program -> [P (Identifier, (SindreOption, Maybe Value))]
programOptions Program
prog
(P (Identifier, P Expr)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> [P (Identifier, P Expr)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((Identifier, P Expr)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> P (Identifier, P Expr)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend (Identifier, P Expr)
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall (m :: * -> *).
MonadBackend m =>
(Identifier, P Expr) -> Compiler m ()
compileGlobal) ([P (Identifier, P Expr)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> [P (Identifier, P Expr)]
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ Program -> [P (Identifier, P Expr)]
programGlobals Program
prog
(Key
lastwr, InstGUI m
gui) <- ClassMap m -> (Maybe (P Expr), GUI) -> Compiler m (Key, InstGUI m)
forall (m :: * -> *).
MonadBackend m =>
ClassMap m -> (Maybe (P Expr), GUI) -> Compiler m (Key, InstGUI m)
compileGUI ClassMap m
cm ((Maybe (P Expr), GUI) -> Compiler m (Key, InstGUI m))
-> (Maybe (P Expr), GUI) -> Compiler m (Key, InstGUI m)
forall a b. (a -> b) -> a -> b
$ Program -> (Maybe (P Expr), GUI)
programGUI Program
prog
InstObjs m
objs <- Key -> ObjectMap m -> Compiler m (InstObjs m)
forall (m :: * -> *).
MonadBackend m =>
Key -> ObjectMap m -> Compiler m (InstObjs m)
compileObjs (Key
lastwrKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
1) ObjectMap m
om
let lastwr' :: Key
lastwr' = Key
lastwr Key -> Key -> Key
forall a. Num a => a -> a -> a
+ InstObjs m -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length InstObjs m
objs
EventHandler m
handler <- [P (Pattern, Action)] -> Compiler m (EventHandler m)
forall (m :: * -> *).
MonadBackend m =>
[P (Pattern, Action)] -> Compiler m (EventHandler m)
compileActions ([P (Pattern, Action)] -> Compiler m (EventHandler m))
-> [P (Pattern, Action)] -> Compiler m (EventHandler m)
forall a b. (a -> b) -> a -> b
$ Program -> [P (Pattern, Action)]
programActions Program
prog
Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ do
[(Key, DataSlot m)]
ws <- InstGUI m -> Sindre m [(Key, DataSlot m)]
forall (m :: * -> *).
MonadBackend m =>
InstGUI m -> Sindre m [(Key, DataSlot m)]
initGUI InstGUI m
gui
[(Key, DataSlot m)]
os <- InstObjs m -> Sindre m [(Key, DataSlot m)]
forall (m :: * -> *).
MonadBackend m =>
InstObjs m -> Sindre m [(Key, DataSlot m)]
initObjs InstObjs m
objs
(SindreEnv m -> SindreEnv m) -> Sindre m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv m -> SindreEnv m) -> Sindre m ())
-> (SindreEnv m -> SindreEnv m) -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv m
s -> SindreEnv m
s { objects :: Array Key (DataSlot m)
objects = (Key, Key) -> [(Key, DataSlot m)] -> Array Key (DataSlot m)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Key
0, Key
lastwr') ([(Key, DataSlot m)] -> Array Key (DataSlot m))
-> [(Key, DataSlot m)] -> Array Key (DataSlot m)
forall a b. (a -> b) -> a -> b
$ [(Key, DataSlot m)]
ws[(Key, DataSlot m)] -> [(Key, DataSlot m)] -> [(Key, DataSlot m)]
forall a. [a] -> [a] -> [a]
++[(Key, DataSlot m)]
os }
[(Identifier, Execution m Value)]
funs' <- [P (Identifier, Function)]
-> (P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[(Identifier, Execution m Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [P (Identifier, Function)]
funs ((P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[(Identifier, Execution m Value)])
-> (P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[(Identifier, Execution m Value)]
forall a b. (a -> b) -> a -> b
$ ((Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend (((Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> ((Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> P (Identifier, Function)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall a b. (a -> b) -> a -> b
$ \(Identifier
k, Function
f) ->
case ((P (Identifier, Function) -> Bool)
-> [P (Identifier, Function)] -> [P (Identifier, Function)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==Identifier
k) (Identifier -> Bool)
-> (P (Identifier, Function) -> Identifier)
-> P (Identifier, Function)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, Function) -> Identifier
forall a b. (a, b) -> a
fst ((Identifier, Function) -> Identifier)
-> (P (Identifier, Function) -> (Identifier, Function))
-> P (Identifier, Function)
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P (Identifier, Function) -> (Identifier, Function)
forall a. P a -> a
unP) [P (Identifier, Function)]
funs,
Identifier
-> FuncMap m -> Maybe (Compiler m ([Value] -> Sindre m Value))
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k FuncMap m
fm) of
(P (Identifier, Function)
_:P (Identifier, Function)
_:[P (Identifier, Function)]
_, Maybe (Compiler m ([Value] -> Sindre m Value))
_) -> Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall a b. (a -> b) -> a -> b
$
Identifier
"Multiple definitions of function '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
([P (Identifier, Function)]
_, Just Compiler m ([Value] -> Sindre m Value)
_) -> Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value))
-> Identifier
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall a b. (a -> b) -> a -> b
$
Identifier
"Redefinition of built-in function '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
([P (Identifier, Function)],
Maybe (Compiler m ([Value] -> Sindre m Value)))
_ -> do Execution m Value
f' <- Function -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Function -> Compiler m (Execution m Value)
compileFunction Function
f
(Identifier, Execution m Value)
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Identifier, Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Identifier
k, Execution m Value
f')
Map Identifier (Execution m Value)
fm' <- FuncMap m
-> (Compiler m ([Value] -> Sindre m Value)
-> Compiler m (Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Map Identifier (Execution m Value))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for FuncMap m
fm ((Compiler m ([Value] -> Sindre m Value)
-> Compiler m (Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Map Identifier (Execution m Value)))
-> (Compiler m ([Value] -> Sindre m Value)
-> Compiler m (Execution m Value))
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Map Identifier (Execution m Value))
forall a b. (a -> b) -> a -> b
$ \Compiler m ([Value] -> Sindre m Value)
e -> do
[Value] -> Sindre m Value
e' <- Compiler m ([Value] -> Sindre m Value)
e
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ Sindre m Value -> Execution m Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m Value -> Execution m Value)
-> ([Value] -> Sindre m Value) -> [Value] -> Execution m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Sindre m Value
e' ([Value] -> Execution m Value)
-> Execution m [Value] -> Execution m Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntMap Value -> [Value]
forall a. IntMap a -> [a]
IM.elems (IntMap Value -> [Value])
-> Execution m (IntMap Value) -> Execution m [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sindre m (IntMap Value) -> Execution m (IntMap Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre ((SindreEnv m -> IntMap Value) -> Sindre m (IntMap Value)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv m -> IntMap Value
forall (m :: * -> *). SindreEnv m -> IntMap Value
execFrame)
[Execution m ()]
begin <- (P Stmt
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Execution m ()))
-> P Stmt
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
(Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) ([P Stmt]
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[Execution m ()])
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Sindre m ())
CompilerState
Identity
[Execution m ()]
forall a b. (a -> b) -> a -> b
$ Program -> [P Stmt]
programBegin Program
prog
Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ())
-> Sindre m ()
-> RWST (CompilerEnv m) (Sindre m ()) CompilerState Identity ()
forall a b. (a -> b) -> a -> b
$ Execution m () -> Sindre m ()
forall (m :: * -> *) a.
MonadBackend m =>
Execution m a -> Sindre m ()
execute_ (Execution m () -> Sindre m ()) -> Execution m () -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
nextHere (Execution m () -> Execution m ())
-> Execution m () -> Execution m ()
forall a b. (a -> b) -> a -> b
$ [Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Execution m ()]
begin
(Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef)
-> Compiler
m
(Map Identifier (Execution m Value), EventHandler m,
[SindreOption], WidgetRef)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Identifier, Execution m Value)]
-> Map Identifier (Execution m Value)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Identifier, Execution m Value)]
funs' Map Identifier (Execution m Value)
-> Map Identifier (Execution m Value)
-> Map Identifier (Execution m Value)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Identifier (Execution m Value)
fm',
EventHandler m
handler, [SindreOption]
opts, InstGUI m -> WidgetRef
forall (m :: * -> *). InstGUI m -> WidgetRef
rootwref InstGUI m
gui)
in ([SindreOption]
options, Sindre m ()
initialiser Sindre m () -> Sindre m () -> Sindre m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventHandler m -> Sindre m ()
forall (m :: * -> *).
MonadBackend m =>
EventHandler m -> Sindre m ()
eventLoop EventHandler m
evhandler, WidgetRef
rootw)
where funs :: [P (Identifier, Function)]
funs = Program -> [P (Identifier, Function)]
programFunctions Program
prog
rootwref :: InstGUI m -> WidgetRef
rootwref (InstGUI WidgetRef
r Constructor m
_ WidgetArgs m
_ [(Maybe (Execution m Value), InstGUI m)]
_) = WidgetRef
r
compileFunction :: MonadBackend m => Function -> Compiler m (Execution m Value)
compileFunction :: Function -> Compiler m (Execution m Value)
compileFunction (Function [Identifier]
args [P Stmt]
body) =
(CompilerEnv m -> CompilerEnv m)
-> Compiler m (Execution m Value) -> Compiler m (Execution m Value)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CompilerEnv m
s -> CompilerEnv m
s { lexicalScope :: Map Identifier Key
lexicalScope = Map Identifier Key
argmap }) (Compiler m (Execution m Value) -> Compiler m (Execution m Value))
-> Compiler m (Execution m Value) -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
[Execution m ()]
exs <- (P Stmt
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m ()))
-> P Stmt
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
body
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
[Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Execution m ()]
exs
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
falsity
where argmap :: Map Identifier Key
argmap = [(Identifier, Key)] -> Map Identifier Key
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Key)] -> Map Identifier Key)
-> [(Identifier, Key)] -> Map Identifier Key
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Key] -> [(Identifier, Key)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
args [Key
0..]
compileAction :: MonadBackend m => [Identifier] -> Action
-> Compiler m (Execution m ())
compileAction :: [Identifier] -> Action -> Compiler m (Execution m ())
compileAction [Identifier]
args (StmtAction [P Stmt]
body) =
(CompilerEnv m -> CompilerEnv m)
-> Compiler m (Execution m ()) -> Compiler m (Execution m ())
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\CompilerEnv m
s -> CompilerEnv m
s { lexicalScope :: Map Identifier Key
lexicalScope = Map Identifier Key
argmap }) (Compiler m (Execution m ()) -> Compiler m (Execution m ()))
-> Compiler m (Execution m ()) -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ do
[Execution m ()]
exs <- (P Stmt -> Compiler m (Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
body
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ [Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Execution m ()]
exs
where argmap :: Map Identifier Key
argmap = [(Identifier, Key)] -> Map Identifier Key
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Key)] -> Map Identifier Key)
-> [(Identifier, Key)] -> Map Identifier Key
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Key] -> [(Identifier, Key)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Identifier]
args [Key
0..]
compilePattern :: MonadBackend m => Pattern
-> Compiler m ( Event -> Execution m (Maybe [Value])
, [Identifier])
compilePattern :: Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
compilePattern (ChordPattern Chord
kp1) = (Event -> Execution m (Maybe [Value]), [Identifier])
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Execution m (Maybe [Value])
forall (m :: * -> *) a. Monad m => Event -> m (Maybe [a])
f, [])
where f :: Event -> m (Maybe [a])
f (KeyPress Chord
kp2) | Chord
kp1 Chord -> Chord -> Bool
forall a. Eq a => a -> a -> Bool
== Chord
kp2 = Maybe [a] -> m (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [a] -> m (Maybe [a])) -> Maybe [a] -> m (Maybe [a])
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. a -> Maybe a
Just []
| Bool
otherwise = Maybe [a] -> m (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing
f Event
_ = Maybe [a] -> m (Maybe [a])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [a]
forall a. Maybe a
Nothing
compilePattern (OrPattern Pattern
p1 Pattern
p2) = do
(Event -> Execution m (Maybe [Value])
p1', [Identifier]
ids1) <- Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *).
MonadBackend m =>
Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
compilePattern Pattern
p1
(Event -> Execution m (Maybe [Value])
p2', [Identifier]
ids2) <- Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *).
MonadBackend m =>
Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
compilePattern Pattern
p2
let check :: Event -> Execution m (Maybe [Value])
check Event
ev = do
Maybe [Value]
v1 <- Event -> Execution m (Maybe [Value])
p1' Event
ev
Maybe [Value]
v2 <- Event -> Execution m (Maybe [Value])
p2' Event
ev
Maybe [Value] -> Execution m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> Execution m (Maybe [Value]))
-> Maybe [Value] -> Execution m (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ case (Maybe [Value]
v1, Maybe [Value]
v2) of
(Just [Value]
vs1, Just [Value]
vs2) -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value]
vs1[Value] -> [Value] -> [Value]
forall a. [a] -> [a] -> [a]
++[Value]
vs2
(Just [Value]
vs1, Maybe [Value]
Nothing) -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
vs1
(Maybe [Value]
Nothing, Just [Value]
vs2) -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
vs2
(Maybe [Value], Maybe [Value])
_ -> Maybe [Value]
forall a. Maybe a
Nothing
(Event -> Execution m (Maybe [Value]), [Identifier])
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Execution m (Maybe [Value])
check, [Identifier]
ids1 [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier]
ids2)
compilePattern (SourcedPattern (NamedSource Identifier
wn Maybe Identifier
fn) Identifier
evn [Identifier]
args) = do
Value
cv <- Identifier -> Compiler m Value
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m Value
constant Identifier
wn
case Value
cv of
Reference WidgetRef
wr -> (Event -> Execution m (Maybe [Value]), [Identifier])
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return (WidgetRef -> Event -> Execution m (Maybe [Value])
forall (m :: * -> *).
Monad m =>
WidgetRef -> Event -> m (Maybe [Value])
f WidgetRef
wr, [Identifier]
args)
Value
_ -> Identifier
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier]))
-> Identifier
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall a b. (a -> b) -> a -> b
$ Identifier
"'" Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
wn Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
"' is not an object."
where f :: WidgetRef -> Event -> m (Maybe [Value])
f WidgetRef
wr (NamedEvent Identifier
evn2 [Value]
vs (FieldSrc WidgetRef
wr2 Identifier
fn2))
| WidgetRef
wr WidgetRef -> WidgetRef -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetRef
wr2, Identifier
evn2 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
evn, Identifier
fn2 Identifier -> Maybe Identifier -> Bool
`fcmp` Maybe Identifier
fn = Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> m (Maybe [Value]))
-> Maybe [Value] -> m (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
vs
f WidgetRef
wr (NamedEvent Identifier
evn2 [Value]
vs (ObjectSrc WidgetRef
wr2))
| WidgetRef
wr WidgetRef -> WidgetRef -> Bool
forall a. Eq a => a -> a -> Bool
== WidgetRef
wr2, Identifier
evn2 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
evn, Maybe Identifier
Nothing <- Maybe Identifier
fn = Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> m (Maybe [Value]))
-> Maybe [Value] -> m (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
vs
f WidgetRef
_ Event
_ = Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing
compilePattern (SourcedPattern (GenericSource Identifier
cn Identifier
wn Maybe Identifier
fn) Identifier
evn [Identifier]
args) =
(Event -> Execution m (Maybe [Value]), [Identifier])
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Execution m (Maybe [Value])
forall (m :: * -> *). Monad m => Event -> m (Maybe [Value])
f, Identifier
wnIdentifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
:[Identifier]
args)
where f :: Event -> m (Maybe [Value])
f (NamedEvent Identifier
evn2 [Value]
vs (FieldSrc wr2 :: WidgetRef
wr2@(Key
_,Identifier
cn2,Maybe Identifier
_) Identifier
fn2))
| Identifier
cnIdentifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==Identifier
cn2, Identifier
evn2 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
evn, Identifier
fn2 Identifier -> Maybe Identifier -> Bool
`fcmp` Maybe Identifier
fn =
Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> m (Maybe [Value]))
-> Maybe [Value] -> m (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ WidgetRef -> Value
Reference WidgetRef
wr2 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
vs
f (NamedEvent Identifier
evn2 [Value]
vs (ObjectSrc wr2 :: WidgetRef
wr2@(Key
_,Identifier
cn2,Maybe Identifier
_)))
| Identifier
cnIdentifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==Identifier
cn2, Identifier
evn2 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
evn, Maybe Identifier
Nothing <- Maybe Identifier
fn =
Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Value] -> m (Maybe [Value]))
-> Maybe [Value] -> m (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just ([Value] -> Maybe [Value]) -> [Value] -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ WidgetRef -> Value
Reference WidgetRef
wr2 Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
vs
f Event
_ = Maybe [Value] -> m (Maybe [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Value]
forall a. Maybe a
Nothing
fcmp :: Identifier -> Maybe Identifier -> Bool
fcmp :: Identifier -> Maybe Identifier -> Bool
fcmp Identifier
f = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool)
-> (Maybe Identifier -> Maybe Bool) -> Maybe Identifier -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Bool) -> Maybe Identifier -> Maybe Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
==Identifier
f)
compileActions :: MonadBackend m => [P (Pattern, Action)]
-> Compiler m (EventHandler m)
compileActions :: [P (Pattern, Action)] -> Compiler m (EventHandler m)
compileActions [P (Pattern, Action)]
reacts = do
[(Event -> Execution m (Maybe [Value]), Execution m ())]
reacts' <- (P (Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ()))
-> [P (Pattern, Action)]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[(Event -> Execution m (Maybe [Value]), Execution m ())]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ()))
-> P (Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend (Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ())
forall (m :: * -> *).
MonadBackend m =>
(Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ())
compileReaction) [P (Pattern, Action)]
reacts
EventHandler m -> Compiler m (EventHandler m)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventHandler m -> Compiler m (EventHandler m))
-> EventHandler m -> Compiler m (EventHandler m)
forall a b. (a -> b) -> a -> b
$ \Event
ev -> do Event
-> [(Event -> Execution m (Maybe [Value]), Execution m ())]
-> Execution m ()
forall (t :: * -> *) (m :: * -> *) t.
(Foldable t, MonadBackend m) =>
t
-> t (t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ()
dispatch Event
ev [(Event -> Execution m (Maybe [Value]), Execution m ())]
reacts'
case Event
ev of
KeyPress Chord
_ ->
(WidgetRef -> EventHandler m)
-> Event -> WidgetRef -> Execution m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip WidgetRef -> EventHandler m
forall (im :: * -> *).
MonadBackend im =>
WidgetRef -> Event -> Execution im ()
recvEventByRef Event
ev (WidgetRef -> Execution m ())
-> Execution m WidgetRef -> Execution m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sindre m WidgetRef -> Execution m WidgetRef
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre ((SindreEnv m -> WidgetRef) -> Sindre m WidgetRef
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv m -> WidgetRef
forall (m :: * -> *). SindreEnv m -> WidgetRef
kbdFocus)
Event
_ -> () -> Execution m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where compileReaction :: (Pattern, Action)
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ())
compileReaction (Pattern
pat, Action
act) = do
(Event -> Execution m (Maybe [Value])
pat', [Identifier]
args) <- Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
forall (m :: * -> *).
MonadBackend m =>
Pattern
-> Compiler m (Event -> Execution m (Maybe [Value]), [Identifier])
compilePattern Pattern
pat
Execution m ()
act' <- [Identifier] -> Action -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
[Identifier] -> Action -> Compiler m (Execution m ())
compileAction [Identifier]
args Action
act
(Event -> Execution m (Maybe [Value]), Execution m ())
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Event -> Execution m (Maybe [Value]), Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Event -> Execution m (Maybe [Value])
pat', Execution m ()
act')
dispatch :: t
-> t (t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ()
dispatch t
ev = ((t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ())
-> t (t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (((t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ())
-> t (t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ())
-> ((t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ())
-> t (t -> Execution m (Maybe [Value]), Execution m ())
-> Execution m ()
forall a b. (a -> b) -> a -> b
$ \(t -> Execution m (Maybe [Value])
applies, Execution m ()
apply) -> do
Maybe [Value]
vs <- t -> Execution m (Maybe [Value])
applies t
ev
case Maybe [Value]
vs of
Just [Value]
vs' -> [Value] -> Execution m () -> Execution m ()
forall (m :: * -> *) a.
MonadBackend m =>
[Value] -> Execution m a -> Execution m a
setScope [Value]
vs' Execution m ()
apply
Maybe [Value]
Nothing -> () -> Execution m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compileStmt :: MonadBackend m => Stmt -> Compiler m (Execution m ())
compileStmt :: Stmt -> Compiler m (Execution m ())
compileStmt (Print [P Expr]
xs) = do
[Execution m Value]
xs' <- (P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> [P Expr]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr) [P Expr]
xs
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ do
[Identifier]
vs <- (Value -> Identifier) -> [Value] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Identifier
forall a. Show a => a -> Identifier
show ([Value] -> [Identifier])
-> Execution m [Value] -> Execution m [Identifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Execution m Value] -> Execution m [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Execution m Value]
xs'
m () -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back (m () -> Execution m ()) -> m () -> Execution m ()
forall a b. (a -> b) -> a -> b
$ do
Identifier -> m ()
forall (m :: * -> *). MonadBackend m => Identifier -> m ()
printVal (Identifier -> m ()) -> Identifier -> m ()
forall a b. (a -> b) -> a -> b
$ [Identifier] -> Identifier
unwords [Identifier]
vs
Identifier -> m ()
forall (m :: * -> *). MonadBackend m => Identifier -> m ()
printVal Identifier
"\n"
compileStmt (Exit Maybe (P Expr)
Nothing) =
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Initialisation m -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Initialisation m -> Execution m ())
-> Initialisation m -> Execution m ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> Initialisation m
forall (m :: * -> *). MonadBackend m => ExitCode -> Sindre m ()
quitSindre ExitCode
ExitSuccess
compileStmt (Exit (Just P Expr
e)) = do
Execution m Value
e' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Identifier -> Execution m ()
bad <- Compiler m (Identifier -> Execution m ())
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
e'
case Value -> Maybe Integer
forall a. Mold a => Value -> Maybe a
mold Value
v :: Maybe Integer of
Just Integer
0 -> Initialisation m -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Initialisation m -> Execution m ())
-> Initialisation m -> Execution m ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> Initialisation m
forall (m :: * -> *). MonadBackend m => ExitCode -> Sindre m ()
quitSindre ExitCode
ExitSuccess
Just Integer
x -> Initialisation m -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Initialisation m -> Execution m ())
-> Initialisation m -> Execution m ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> Initialisation m
forall (m :: * -> *). MonadBackend m => ExitCode -> Sindre m ()
quitSindre (ExitCode -> Initialisation m) -> ExitCode -> Initialisation m
forall a b. (a -> b) -> a -> b
$ Key -> ExitCode
ExitFailure (Key -> ExitCode) -> Key -> ExitCode
forall a b. (a -> b) -> a -> b
$ Integer -> Key
forall a b. (Integral a, Num b) => a -> b
fi Integer
x
Maybe Integer
Nothing -> Identifier -> Execution m ()
bad Identifier
"Exit code must be an integer"
compileStmt (Expr P Expr
e) = do
Execution m Value
e' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Execution m Value -> Execution m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Execution m Value
e'
compileStmt (Return (Just P Expr
e)) = do
Execution m Value
e' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Value -> Execution m ()
forall (m :: * -> *). MonadBackend m => Value -> Execution m ()
doReturn (Value -> Execution m ()) -> Execution m Value -> Execution m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Execution m Value
e'
compileStmt (Return Maybe (P Expr)
Nothing) =
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Value -> Execution m ()
forall (m :: * -> *). MonadBackend m => Value -> Execution m ()
doReturn Value
falsity
compileStmt Stmt
Next = Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return Execution m ()
forall (m :: * -> *). MonadBackend m => Execution m ()
doNext
compileStmt Stmt
Break = Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return Execution m ()
forall (m :: * -> *). MonadBackend m => Execution m ()
doBreak
compileStmt Stmt
Continue = Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return Execution m ()
forall (m :: * -> *). MonadBackend m => Execution m ()
doCont
compileStmt (If P Expr
e [P Stmt]
trueb [P Stmt]
falseb) = do
Execution m Value
e' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
[Execution m ()]
trueb' <- (P Stmt -> Compiler m (Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
trueb
[Execution m ()]
falseb' <- (P Stmt -> Compiler m (Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
falseb
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
e'
[Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Execution m ()] -> Execution m ())
-> [Execution m ()] -> Execution m ()
forall a b. (a -> b) -> a -> b
$ if Value -> Bool
true Value
v then [Execution m ()]
trueb' else [Execution m ()]
falseb'
compileStmt (While P Expr
c [P Stmt]
body) =
Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt (Stmt -> Compiler m (Execution m ()))
-> Stmt -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ P Expr -> P Expr -> P Expr -> [P Stmt] -> Stmt
For P Expr
blank P Expr
c P Expr
blank [P Stmt]
body
where blank :: P Expr
blank = Value -> Expr
Literal Value
falsity Expr -> P Expr -> P Expr
forall a b. a -> P b -> P a
`at` P Expr
c
compileStmt (For P Expr
e1 P Expr
e2 P Expr
e3 [P Stmt]
body) = do
[Execution m ()]
body' <- (P Stmt -> Compiler m (Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
body
Execution m Value
e1' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e1
Execution m Value
e2' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e2
Execution m Value
e3' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e3
let stmt :: Execution m ()
stmt = do
Value
v <- Execution m Value
e2'
Bool -> Execution m () -> Execution m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value -> Bool
true Value
v) (Execution m () -> Execution m ())
-> Execution m () -> Execution m ()
forall a b. (a -> b) -> a -> b
$ Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
contHere ([Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Execution m ()]
body') Execution m () -> Execution m Value -> Execution m Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Execution m Value
e3' Execution m Value -> Execution m () -> Execution m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Execution m ()
stmt
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Execution m Value
e1' Execution m Value -> Execution m () -> Execution m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
breakHere Execution m ()
stmt
compileStmt (Do [P Stmt]
body P Expr
c) = do
[Execution m ()]
body' <- (P Stmt -> Compiler m (Execution m ()))
-> [P Stmt]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt) [P Stmt]
body
Execution m ()
loop' <- (Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Stmt -> Compiler m (Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Stmt -> Compiler m (Execution m ())
compileStmt (P Stmt -> Compiler m (Execution m ()))
-> P Stmt -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ P Expr -> [P Stmt] -> Stmt
While P Expr
c [P Stmt]
body Stmt -> P Expr -> P Stmt
forall a b. a -> P b -> P a
`at` P Expr
c
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
breakHere (Execution m () -> Execution m ())
-> Execution m () -> Execution m ()
forall a b. (a -> b) -> a -> b
$ Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
contHere ([Execution m ()] -> Execution m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Execution m ()]
body') Execution m () -> Execution m () -> Execution m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Execution m ()
loop'
compileStmt (Focus P Expr
e) = do
Execution m Value
e' <- (Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value))
-> P Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
(Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Identifier -> Execution m ()
bad <- Compiler m (Identifier -> Execution m ())
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m () -> Compiler m (Execution m ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m () -> Compiler m (Execution m ()))
-> Execution m () -> Compiler m (Execution m ())
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
e'
case Value
v of
Reference WidgetRef
r -> Initialisation m -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Initialisation m -> Execution m ())
-> Initialisation m -> Execution m ()
forall a b. (a -> b) -> a -> b
$ (SindreEnv m -> SindreEnv m) -> Initialisation m
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv m -> SindreEnv m) -> Initialisation m)
-> (SindreEnv m -> SindreEnv m) -> Initialisation m
forall a b. (a -> b) -> a -> b
$ \SindreEnv m
s -> SindreEnv m
s { kbdFocus :: WidgetRef
kbdFocus = WidgetRef
r }
Value
_ -> Identifier -> Execution m ()
bad Identifier
"Focus is not a widget reference"
compileExpr :: MonadBackend m => Expr -> Compiler m (Execution m Value)
compileExpr :: Expr -> Compiler m (Execution m Value)
compileExpr (Literal Value
v) = Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
compileExpr (Var Identifier
v) = Identifier -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m (Execution m Value)
value Identifier
v
compileExpr (P SourcePos
_ (Var Identifier
k) `Assign` P Expr
e) = do
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Value -> Execution m ()
set <- Identifier -> Compiler m (Value -> Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m (Value -> Execution m ())
setValue Identifier
k
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
e'
Value -> Execution m ()
set Value
v
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
compileExpr (Not P Expr
e) = do
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
e'
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ if Value -> Bool
true Value
v then Value
falsity else Value
truth
compileExpr (P Expr
e1 `Equal` P Expr
e2) =
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall (m :: * -> *) a.
MonadBackend m =>
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 ((Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value))
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ \Value
v1 Value
v2 Identifier -> Execution m Any
_ ->
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$! if Value
v1 Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
v2 then Value
truth else Value
falsity
compileExpr (P Expr
e1 `LessThan` P Expr
e2) =
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall (m :: * -> *) a.
MonadBackend m =>
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 ((Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value))
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ \Value
v1 Value
v2 Identifier -> Execution m Any
_ ->
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$! if Value
v1 Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
< Value
v2 then Value
truth else Value
falsity
compileExpr (P Expr
e1 `LessEql` P Expr
e2) =
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall (m :: * -> *) a.
MonadBackend m =>
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 ((Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value))
-> (Value
-> Value -> (Identifier -> Execution m Any) -> Execution m Value)
-> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ \Value
v1 Value
v2 Identifier -> Execution m Any
_ ->
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$! if Value
v1 Value -> Value -> Bool
forall a. Ord a => a -> a -> Bool
<= Value
v2 then Value
truth else Value
falsity
compileExpr (P SourcePos
_ (P SourcePos
_ (Var Identifier
k) `Lookup` P Expr
e1) `Assign` P Expr
e2) = do
Execution m Value
e1' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e1
Execution m Value
e2' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e2
Execution m Value
k' <- Identifier -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m (Execution m Value)
value Identifier
k
Value -> Execution m ()
set <- Identifier -> Compiler m (Value -> Execution m ())
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m (Value -> Execution m ())
setValue Identifier
k
Identifier -> Execution m ()
bad <- Compiler m (Identifier -> Execution m ())
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v1 <- Execution m Value
e1'
Value
v2 <- Execution m Value
e2'
Value
o <- Execution m Value
k'
case Value
o of
Dict Map Value Value
m ->
Value -> Execution m ()
set (Value -> Execution m ()) -> Value -> Execution m ()
forall a b. (a -> b) -> a -> b
$! Map Value Value -> Value
Dict (Map Value Value -> Value) -> Map Value Value -> Value
forall a b. (a -> b) -> a -> b
$! Value -> Value -> Map Value Value -> Map Value Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Value
v1 Value
v2 Map Value Value
m
Value
_ -> Identifier -> Execution m ()
bad Identifier
"Not a dictionary"
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v2
compileExpr (P SourcePos
_ (Identifier
s `FieldOf` P Expr
oe) `Assign` P Expr
e) = do
Execution m Value
oe' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
oe
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Identifier -> Execution m Value
bad <- Compiler m (Identifier -> Execution m Value)
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
o <- Execution m Value
oe'
Value
v <- Execution m Value
e'
case Value
o of
Reference WidgetRef
wr -> do Value
_ <- WidgetRef -> Identifier -> Value -> Execution m Value
forall (im :: * -> *).
MonadBackend im =>
WidgetRef -> Identifier -> Value -> Execution im Value
setFieldByRef WidgetRef
wr Identifier
s Value
v
Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
Value
_ -> Identifier -> Execution m Value
bad Identifier
"Not an object"
compileExpr (P Expr
_ `Assign` P Expr
_) = Identifier -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError Identifier
"Cannot assign to rvalue"
compileExpr (P Expr
e `Lookup` P Expr
fe) = do
Execution m Value
fe' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
fe
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Identifier -> Execution m Value
bad <- Compiler m (Identifier -> Execution m Value)
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
fe'
Value
o <- Execution m Value
e'
case Value
o of
Dict Map Value Value
m -> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
falsity (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$! Value -> Map Value Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Value
v Map Value Value
m
Value
_ -> Identifier -> Execution m Value
bad Identifier
"Not a dictionary"
compileExpr (Identifier
s `FieldOf` P Expr
oe) = do
Execution m Value
oe' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
oe
Identifier -> Execution m Value
bad <- Compiler m (Identifier -> Execution m Value)
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
o <- Execution m Value
oe'
case Value
o of
Reference WidgetRef
wr -> WidgetRef -> Identifier -> Execution m Value
forall (im :: * -> *).
MonadBackend im =>
WidgetRef -> Identifier -> Execution im Value
getFieldByRef WidgetRef
wr Identifier
s
Value
_ -> Identifier -> Execution m Value
bad Identifier
"Not an object"
compileExpr (Methcall P Expr
oe Identifier
meth [P Expr]
argexps) = do
[Execution m Value]
argexps' <- (P Expr -> Compiler m (Execution m Value))
-> [P Expr]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr) [P Expr]
argexps
Execution m Value
o' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
oe
Identifier -> Execution m Value
bad <- Compiler m (Identifier -> Execution m Value)
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
[Value]
argvs <- [Execution m Value] -> Execution m [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Execution m Value]
argexps'
Value
v <- Execution m Value
o'
case Value
v of
Reference WidgetRef
wr -> WidgetRef -> Identifier -> [Value] -> Execution m Value
forall (im :: * -> *).
MonadBackend im =>
WidgetRef -> Identifier -> [Value] -> Execution im Value
callMethodByRef WidgetRef
wr Identifier
meth [Value]
argvs
Value
_ -> Identifier -> Execution m Value
bad Identifier
"Not an object"
compileExpr (Funcall Identifier
f [P Expr]
argexps) = do
[Execution m Value]
argexps' <- (P Expr -> Compiler m (Execution m Value))
-> [P Expr]
-> RWST
(CompilerEnv m)
(Initialisation m)
CompilerState
Identity
[Execution m Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr) [P Expr]
argexps
Execution m Value
f' <- Identifier -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Identifier -> Compiler m (Execution m Value)
function Identifier
f
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
[Value]
argv <- [Execution m Value] -> Execution m [Value]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Execution m Value]
argexps'
[Value] -> Execution m Value -> Execution m Value
forall (m :: * -> *) a.
MonadBackend m =>
[Value] -> Execution m a -> Execution m a
enterScope [Value]
argv (Execution m Value -> Execution m Value)
-> Execution m Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Execution m Value -> Execution m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Execution m Value
returnHere Execution m Value
f'
compileExpr (Cond P Expr
c P Expr
trueb P Expr
falseb) = do
Execution m Value
c' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
c
Execution m Value
trueb' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
trueb
Execution m Value
falseb' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
falseb
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v <- Execution m Value
c'
if Value -> Bool
true Value
v then Execution m Value
trueb' else Execution m Value
falseb'
compileExpr (Concat P Expr
e1 P Expr
e2) = P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value)
forall (m :: * -> *) a.
MonadBackend m =>
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 ((Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value))
-> (Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ \Value
v1 Value
v2 Identifier -> Execution m Value
bad ->
case (Value -> Maybe Text
forall a. Mold a => Value -> Maybe a
mold Value
v1, Value -> Maybe Text
forall a. Mold a => Value -> Maybe a
mold Value
v2) of
(Just Text
v1', Just Text
v2') -> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
StringV (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$! Text
v1' Text -> Text -> Text
`T.append` Text
v2'
(Maybe Text, Maybe Text)
_ -> Identifier -> Execution m Value
bad Identifier
"Can only concatenate strings"
compileExpr (PostInc P Expr
e) = do
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Execution m Value
p' <- Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr (Expr -> Compiler m (Execution m Value))
-> Expr -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ P Expr
e P Expr -> P Expr -> Expr
`Assign` (P Expr -> P Expr -> Expr
Plus P Expr
e (Value -> Expr
Literal (Double -> Value
Number Double
1) Expr -> P Expr -> P Expr
forall a b. a -> P b -> P a
`at` P Expr
e) Expr -> P Expr -> P Expr
forall a b. a -> P b -> P a
`at` P Expr
e)
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ Execution m Value
e' Execution m Value -> Execution m Value -> Execution m Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Execution m Value
p'
compileExpr (PostDec P Expr
e) = do
Execution m Value
e' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e
Execution m Value
p' <- Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr (Expr -> Compiler m (Execution m Value))
-> Expr -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ P Expr
e P Expr -> P Expr -> Expr
`Assign` (P Expr -> P Expr -> Expr
Minus P Expr
e (Value -> Expr
Literal (Double -> Value
Number Double
1) Expr -> P Expr -> P Expr
forall a b. a -> P b -> P a
`at` P Expr
e) Expr -> P Expr -> P Expr
forall a b. a -> P b -> P a
`at` P Expr
e)
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ Execution m Value
e' Execution m Value -> Execution m Value -> Execution m Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Execution m Value
p'
compileExpr (P Expr
e1 `Plus` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Identifier
"add" P Expr
e1 P Expr
e2
compileExpr (P Expr
e1 `Minus` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop (-) Identifier
"subtract" P Expr
e1 P Expr
e2
compileExpr (P Expr
e1 `Times` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Identifier
"multiply" P Expr
e1 P Expr
e2
compileExpr (P Expr
e1 `Divided` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/) Identifier
"divide" P Expr
e1 P Expr
e2
compileExpr (P Expr
e1 `Modulo` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
forall a. Real a => a -> a -> a
mod' Identifier
"take modulo" P Expr
e1 P Expr
e2
compileExpr (P Expr
e1 `RaisedTo` P Expr
e2) = (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
(Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
forall a. Floating a => a -> a -> a
(**) Identifier
"exponentiate" P Expr
e1 P Expr
e2
compileBinop :: MonadBackend m =>
P Expr -> P Expr ->
(Value -> Value -> (String -> Execution m a)
-> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop :: P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value
op = do
Execution m Value
e1' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e1
Execution m Value
e2' <- (Expr -> Compiler m (Execution m Value))
-> P Expr -> Compiler m (Execution m Value)
forall a (m :: * -> *) b.
(a -> Compiler m b) -> P a -> Compiler m b
descend Expr -> Compiler m (Execution m Value)
forall (m :: * -> *).
MonadBackend m =>
Expr -> Compiler m (Execution m Value)
compileExpr P Expr
e2
Identifier -> Execution m a
bad <- Compiler m (Identifier -> Execution m a)
forall (m :: * -> *) a.
MonadFail m =>
Compiler m (Identifier -> Execution m a)
runtimeError
Execution m Value -> Compiler m (Execution m Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Execution m Value -> Compiler m (Execution m Value))
-> Execution m Value -> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ do
Value
v1 <- Execution m Value
e1'
Value
v2 <- Execution m Value
e2'
Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value
op Value
v1 Value
v2 Identifier -> Execution m a
bad
compileArithop :: MonadBackend m =>
(Double -> Double -> Double)
-> String -> P Expr -> P Expr
-> Compiler m (Execution m Value)
compileArithop :: (Double -> Double -> Double)
-> Identifier -> P Expr -> P Expr -> Compiler m (Execution m Value)
compileArithop Double -> Double -> Double
op Identifier
opstr P Expr
e1 P Expr
e2 = P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value)
forall (m :: * -> *) a.
MonadBackend m =>
P Expr
-> P Expr
-> (Value
-> Value -> (Identifier -> Execution m a) -> Execution m Value)
-> Compiler m (Execution m Value)
compileBinop P Expr
e1 P Expr
e2 ((Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value))
-> (Value
-> Value -> (Identifier -> Execution m Value) -> Execution m Value)
-> Compiler m (Execution m Value)
forall a b. (a -> b) -> a -> b
$ \Value
v1 Value
v2 Identifier -> Execution m Value
bad ->
case (Value -> Maybe Double
forall a. Mold a => Value -> Maybe a
mold Value
v1, Value -> Maybe Double
forall a. Mold a => Value -> Maybe a
mold Value
v2) of
(Just Double
v1', Just Double
v2') -> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Execution m Value) -> Value -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Double -> Value
Number (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$! Double
v1' Double -> Double -> Double
`op` Double
v2'
(Maybe Double, Maybe Double)
_ -> Identifier -> Execution m Value
bad (Identifier -> Execution m Value)
-> Identifier -> Execution m Value
forall a b. (a -> b) -> a -> b
$ Identifier
"Can only " Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
opstr Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
" numbers"
type WidgetArgs im = M.Map Identifier (Execution im Value)
type Constructor m =
WidgetRef -> [(Maybe Value, ObjectRef)] ->
ConstructorM m (NewWidget m)
data InstGUI m = InstGUI WidgetRef
(Constructor m)
(WidgetArgs m)
[(Maybe (Execution m Value), InstGUI m)]
type InstObjs m = [((Identifier, ObjectRef),
ObjectRef -> m (NewObject m))]
initGUI :: MonadBackend m => InstGUI m
-> Sindre m [(ObjectNum, DataSlot m)]
initGUI :: InstGUI m -> Sindre m [(Key, DataSlot m)]
initGUI (InstGUI r :: WidgetRef
r@(Key
wn,Identifier
_,Maybe Identifier
_) Constructor m
f WidgetArgs m
args [(Maybe (Execution m Value), InstGUI m)]
cs) = do
Map Identifier Value
args' <- (Execution m Value -> Sindre m Value)
-> WidgetArgs m -> Sindre m (Map Identifier Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute WidgetArgs m
args
[(Maybe Value, WidgetRef)]
childrefs <- [(Maybe (Execution m Value), InstGUI m)]
-> ((Maybe (Execution m Value), InstGUI m)
-> Sindre m (Maybe Value, WidgetRef))
-> Sindre m [(Maybe Value, WidgetRef)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Maybe (Execution m Value), InstGUI m)]
cs (((Maybe (Execution m Value), InstGUI m)
-> Sindre m (Maybe Value, WidgetRef))
-> Sindre m [(Maybe Value, WidgetRef)])
-> ((Maybe (Execution m Value), InstGUI m)
-> Sindre m (Maybe Value, WidgetRef))
-> Sindre m [(Maybe Value, WidgetRef)]
forall a b. (a -> b) -> a -> b
$ \(Maybe (Execution m Value)
e, InstGUI WidgetRef
r' Constructor m
_ WidgetArgs m
_ [(Maybe (Execution m Value), InstGUI m)]
_) -> do
Maybe Value
v <- case Maybe (Execution m Value)
e of Just Execution m Value
e' -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Sindre m Value -> Sindre m (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute Execution m Value
e'
Maybe (Execution m Value)
Nothing -> Maybe Value -> Sindre m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
(Maybe Value, WidgetRef) -> Sindre m (Maybe Value, WidgetRef)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value
v,WidgetRef
r')
let constructor :: ConstructorM m (DataSlot m)
constructor = do
Maybe Integer
minw <- Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> ConstructorM m Integer -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> ConstructorM m Integer
forall a (m :: * -> *).
(Mold a, MonadBackend m) =>
Identifier -> ConstructorM m a
param Identifier
"minwidth" ConstructorM m (Maybe Integer)
-> ConstructorM m (Maybe Integer) -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer -> ConstructorM m (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
Maybe Integer
minh <- Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> ConstructorM m Integer -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> ConstructorM m Integer
forall a (m :: * -> *).
(Mold a, MonadBackend m) =>
Identifier -> ConstructorM m a
param Identifier
"minheight" ConstructorM m (Maybe Integer)
-> ConstructorM m (Maybe Integer) -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer -> ConstructorM m (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
Maybe Integer
maxw <- Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> ConstructorM m Integer -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> ConstructorM m Integer
forall a (m :: * -> *).
(Mold a, MonadBackend m) =>
Identifier -> ConstructorM m a
param Identifier
"maxwidth" ConstructorM m (Maybe Integer)
-> ConstructorM m (Maybe Integer) -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer -> ConstructorM m (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
Maybe Integer
maxh <- Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> ConstructorM m Integer -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> ConstructorM m Integer
forall a (m :: * -> *).
(Mold a, MonadBackend m) =>
Identifier -> ConstructorM m a
param Identifier
"maxheight" ConstructorM m (Maybe Integer)
-> ConstructorM m (Maybe Integer) -> ConstructorM m (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Integer -> ConstructorM m (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
NewWidget m
nw <- Constructor m
f WidgetRef
r [(Maybe Value, WidgetRef)]
childrefs
DataSlot m -> ConstructorM m (DataSlot m)
forall (m :: * -> *) a. Monad m => a -> m a
return (DataSlot m -> ConstructorM m (DataSlot m))
-> DataSlot m -> ConstructorM m (DataSlot m)
forall a b. (a -> b) -> a -> b
$ NewWidget m -> Constraints -> DataSlot m
forall (im :: * -> *). NewWidget im -> Constraints -> DataSlot im
instWidget NewWidget m
nw ((Maybe Integer
minw, Maybe Integer
maxw), (Maybe Integer
minh, Maybe Integer
maxh))
DataSlot m
s <- ConstructorM m (DataSlot m)
-> Map Identifier Value -> Sindre m (DataSlot m)
forall (m :: * -> *) a.
MonadBackend m =>
ConstructorM m a -> Map Identifier Value -> Sindre m a
runConstructor ConstructorM m (DataSlot m)
constructor Map Identifier Value
args'
[(Key, DataSlot m)]
children <- ([[(Key, DataSlot m)]] -> [(Key, DataSlot m)])
-> Sindre m [[(Key, DataSlot m)]] -> Sindre m [(Key, DataSlot m)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[(Key, DataSlot m)]] -> [(Key, DataSlot m)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Sindre m [[(Key, DataSlot m)]] -> Sindre m [(Key, DataSlot m)])
-> Sindre m [[(Key, DataSlot m)]] -> Sindre m [(Key, DataSlot m)]
forall a b. (a -> b) -> a -> b
$ ((Maybe (Execution m Value), InstGUI m)
-> Sindre m [(Key, DataSlot m)])
-> [(Maybe (Execution m Value), InstGUI m)]
-> Sindre m [[(Key, DataSlot m)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (InstGUI m -> Sindre m [(Key, DataSlot m)]
forall (m :: * -> *).
MonadBackend m =>
InstGUI m -> Sindre m [(Key, DataSlot m)]
initGUI (InstGUI m -> Sindre m [(Key, DataSlot m)])
-> ((Maybe (Execution m Value), InstGUI m) -> InstGUI m)
-> (Maybe (Execution m Value), InstGUI m)
-> Sindre m [(Key, DataSlot m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Execution m Value), InstGUI m) -> InstGUI m
forall a b. (a, b) -> b
snd) [(Maybe (Execution m Value), InstGUI m)]
cs
[(Key, DataSlot m)] -> Sindre m [(Key, DataSlot m)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Key, DataSlot m)] -> Sindre m [(Key, DataSlot m)])
-> [(Key, DataSlot m)] -> Sindre m [(Key, DataSlot m)]
forall a b. (a -> b) -> a -> b
$ (Key
wn,DataSlot m
s)(Key, DataSlot m) -> [(Key, DataSlot m)] -> [(Key, DataSlot m)]
forall a. a -> [a] -> [a]
:[(Key, DataSlot m)]
children
lookupClass :: ClassMap m -> Identifier -> Compiler m (Constructor m)
lookupClass :: ClassMap m -> Identifier -> Compiler m (Constructor m)
lookupClass ClassMap m
m Identifier
k = Compiler m (Constructor m)
-> (Constructor m -> Compiler m (Constructor m))
-> Maybe (Constructor m)
-> Compiler m (Constructor m)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Compiler m (Constructor m)
forall (m :: * -> *) a. Compiler m a
unknown Constructor m -> Compiler m (Constructor m)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Constructor m) -> Compiler m (Constructor m))
-> Maybe (Constructor m) -> Compiler m (Constructor m)
forall a b. (a -> b) -> a -> b
$ Identifier -> ClassMap m -> Maybe (Constructor m)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k ClassMap m
m
where unknown :: Compiler m a
unknown = Identifier -> Compiler m a
forall (m :: * -> *) a. Identifier -> Compiler m a
compileError (Identifier -> Compiler m a) -> Identifier -> Compiler m a
forall a b. (a -> b) -> a -> b
$ Identifier
"Unknown class '" Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
k Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier
"'"
initObjs :: MonadBackend m =>
InstObjs m -> Sindre m [(ObjectNum, DataSlot m)]
initObjs :: InstObjs m -> Sindre m [(Key, DataSlot m)]
initObjs = (((Identifier, WidgetRef), WidgetRef -> m (NewObject m))
-> Sindre m (Key, DataSlot m))
-> InstObjs m -> Sindre m [(Key, DataSlot m)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((((Identifier, WidgetRef), WidgetRef -> m (NewObject m))
-> Sindre m (Key, DataSlot m))
-> InstObjs m -> Sindre m [(Key, DataSlot m)])
-> (((Identifier, WidgetRef), WidgetRef -> m (NewObject m))
-> Sindre m (Key, DataSlot m))
-> InstObjs m
-> Sindre m [(Key, DataSlot m)]
forall a b. (a -> b) -> a -> b
$ \((Identifier
_, r :: WidgetRef
r@(Key
r',Identifier
_,Maybe Identifier
_)), WidgetRef -> m (NewObject m)
con) -> do
NewObject m
no <- m (NewObject m) -> Sindre m (NewObject m)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back (m (NewObject m) -> Sindre m (NewObject m))
-> m (NewObject m) -> Sindre m (NewObject m)
forall a b. (a -> b) -> a -> b
$ WidgetRef -> m (NewObject m)
con WidgetRef
r
(Key, DataSlot m) -> Sindre m (Key, DataSlot m)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
r', NewObject m -> DataSlot m
forall (im :: * -> *). NewObject im -> DataSlot im
instObject NewObject m
no)
class MonadBackend m => Param m a where
moldM :: Value -> m (Maybe a)
data ParamError = NoParam Identifier | BadValue Identifier Value
deriving (Key -> ParamError -> Identifier -> Identifier
[ParamError] -> Identifier -> Identifier
ParamError -> Identifier
(Key -> ParamError -> Identifier -> Identifier)
-> (ParamError -> Identifier)
-> ([ParamError] -> Identifier -> Identifier)
-> Show ParamError
forall a.
(Key -> a -> Identifier -> Identifier)
-> (a -> Identifier) -> ([a] -> Identifier -> Identifier) -> Show a
showList :: [ParamError] -> Identifier -> Identifier
$cshowList :: [ParamError] -> Identifier -> Identifier
show :: ParamError -> Identifier
$cshow :: ParamError -> Identifier
showsPrec :: Key -> ParamError -> Identifier -> Identifier
$cshowsPrec :: Key -> ParamError -> Identifier -> Identifier
Show)
instance Error ParamError where
strMsg :: Identifier -> ParamError
strMsg = (Identifier -> Value -> ParamError)
-> Value -> Identifier -> ParamError
forall a b c. (a -> b -> c) -> b -> a -> c
flip Identifier -> Value -> ParamError
BadValue Value
falsity
newtype ConstructorM m a = ConstructorM (ErrorT ParamError
(StateT (M.Map Identifier Value)
(Sindre m))
a)
deriving ( MonadState (M.Map Identifier Value)
, MonadError ParamError
, Applicative (ConstructorM m)
a -> ConstructorM m a
Applicative (ConstructorM m)
-> (forall a b.
ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b)
-> (forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b)
-> (forall a. a -> ConstructorM m a)
-> Monad (ConstructorM m)
ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
forall a. a -> ConstructorM m a
forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
forall a b.
ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b
forall (m :: * -> *). Applicative (ConstructorM m)
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) a. a -> ConstructorM m a
forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
forall (m :: * -> *) a b.
ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b
return :: a -> ConstructorM m a
$creturn :: forall (m :: * -> *) a. a -> ConstructorM m a
>> :: ConstructorM m a -> ConstructorM m b -> ConstructorM m b
$c>> :: forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
>>= :: ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b
$c>>= :: forall (m :: * -> *) a b.
ConstructorM m a -> (a -> ConstructorM m b) -> ConstructorM m b
$cp1Monad :: forall (m :: * -> *). Applicative (ConstructorM m)
Monad, Monad (ConstructorM m)
Monad (ConstructorM m)
-> (forall a. Identifier -> ConstructorM m a)
-> MonadFail (ConstructorM m)
Identifier -> ConstructorM m a
forall a. Identifier -> ConstructorM m a
forall (m :: * -> *). Monad (ConstructorM m)
forall (m :: * -> *).
Monad m -> (forall a. Identifier -> m a) -> MonadFail m
forall (m :: * -> *) a. Identifier -> ConstructorM m a
fail :: Identifier -> ConstructorM m a
$cfail :: forall (m :: * -> *) a. Identifier -> ConstructorM m a
$cp1MonadFail :: forall (m :: * -> *). Monad (ConstructorM m)
MonadFail, a -> ConstructorM m b -> ConstructorM m a
(a -> b) -> ConstructorM m a -> ConstructorM m b
(forall a b. (a -> b) -> ConstructorM m a -> ConstructorM m b)
-> (forall a b. a -> ConstructorM m b -> ConstructorM m a)
-> Functor (ConstructorM m)
forall a b. a -> ConstructorM m b -> ConstructorM m a
forall a b. (a -> b) -> ConstructorM m a -> ConstructorM m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> ConstructorM m b -> ConstructorM m a
forall (m :: * -> *) a b.
(a -> b) -> ConstructorM m a -> ConstructorM m b
<$ :: a -> ConstructorM m b -> ConstructorM m a
$c<$ :: forall (m :: * -> *) a b. a -> ConstructorM m b -> ConstructorM m a
fmap :: (a -> b) -> ConstructorM m a -> ConstructorM m b
$cfmap :: forall (m :: * -> *) a b.
(a -> b) -> ConstructorM m a -> ConstructorM m b
Functor, Functor (ConstructorM m)
a -> ConstructorM m a
Functor (ConstructorM m)
-> (forall a. a -> ConstructorM m a)
-> (forall a b.
ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b)
-> (forall a b c.
(a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c)
-> (forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b)
-> (forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m a)
-> Applicative (ConstructorM m)
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
ConstructorM m a -> ConstructorM m b -> ConstructorM m a
ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b
(a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c
forall a. a -> ConstructorM m a
forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m a
forall a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
forall a b.
ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b
forall a b c.
(a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c
forall (m :: * -> *). Functor (ConstructorM m)
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) a. a -> ConstructorM m a
forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m a
forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
forall (m :: * -> *) a b.
ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b
forall (m :: * -> *) a b c.
(a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c
<* :: ConstructorM m a -> ConstructorM m b -> ConstructorM m a
$c<* :: forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m a
*> :: ConstructorM m a -> ConstructorM m b -> ConstructorM m b
$c*> :: forall (m :: * -> *) a b.
ConstructorM m a -> ConstructorM m b -> ConstructorM m b
liftA2 :: (a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c)
-> ConstructorM m a -> ConstructorM m b -> ConstructorM m c
<*> :: ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b
$c<*> :: forall (m :: * -> *) a b.
ConstructorM m (a -> b) -> ConstructorM m a -> ConstructorM m b
pure :: a -> ConstructorM m a
$cpure :: forall (m :: * -> *) a. a -> ConstructorM m a
$cp1Applicative :: forall (m :: * -> *). Functor (ConstructorM m)
Applicative)
noParam :: String -> ConstructorM m a
noParam :: Identifier -> ConstructorM m a
noParam = ParamError -> ConstructorM m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParamError -> ConstructorM m a)
-> (Identifier -> ParamError) -> Identifier -> ConstructorM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> ParamError
NoParam
badValue :: String -> Value -> ConstructorM m a
badValue :: Identifier -> Value -> ConstructorM m a
badValue Identifier
k = ParamError -> ConstructorM m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ParamError -> ConstructorM m a)
-> (Value -> ParamError) -> Value -> ConstructorM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Value -> ParamError
BadValue Identifier
k
runConstructor :: MonadBackend m => ConstructorM m a
-> M.Map Identifier Value -> Sindre m a
runConstructor :: ConstructorM m a -> Map Identifier Value -> Sindre m a
runConstructor (ConstructorM ErrorT ParamError (StateT (Map Identifier Value) (Sindre m)) a
c) Map Identifier Value
m = do
(Either ParamError a
v, Map Identifier Value
m') <- StateT (Map Identifier Value) (Sindre m) (Either ParamError a)
-> Map Identifier Value
-> Sindre m (Either ParamError a, Map Identifier Value)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ErrorT ParamError (StateT (Map Identifier Value) (Sindre m)) a
-> StateT (Map Identifier Value) (Sindre m) (Either ParamError a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT ErrorT ParamError (StateT (Map Identifier Value) (Sindre m)) a
c) Map Identifier Value
m
case Either ParamError a
v of
Left (NoParam Identifier
k) -> Identifier -> Sindre m a
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> Sindre m a) -> Identifier -> Sindre m a
forall a b. (a -> b) -> a -> b
$ Identifier
"Missing argument '"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"
Left (BadValue Identifier
k Value
v') -> Identifier -> Sindre m a
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> Sindre m a) -> Identifier -> Sindre m a
forall a b. (a -> b) -> a -> b
$ Identifier
"Bad value "Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Value -> Identifier
forall a. Show a => a -> Identifier
show Value
v'Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
" for argument '"
Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
kIdentifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier
"'"Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++Identifier -> (Value -> Identifier) -> Maybe Value -> Identifier
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Identifier
"" ((Identifier
": "Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++) (Identifier -> Identifier)
-> (Value -> Identifier) -> Value -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Identifier
forall a. Show a => a -> Identifier
show) (Identifier -> Map Identifier Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k Map Identifier Value
m)
Right a
_ | Map Identifier Value
m' Map Identifier Value -> Map Identifier Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Map Identifier Value
forall k a. Map k a
M.empty ->
Identifier -> Sindre m a
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> Sindre m a) -> Identifier -> Sindre m a
forall a b. (a -> b) -> a -> b
$ Identifier
"Surplus arguments: " Identifier -> Identifier -> Identifier
forall a. [a] -> [a] -> [a]
++ Identifier -> [Identifier] -> Identifier
forall a. [a] -> [[a]] -> [a]
intercalate Identifier
"," (Map Identifier Value -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier Value
m')
Right a
v' -> a -> Sindre m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v'
instance MonadBackend m => Alternative (ConstructorM m) where
empty :: ConstructorM m a
empty = Identifier -> ConstructorM m a
forall (m :: * -> *) a. Identifier -> ConstructorM m a
noParam Identifier
"<none>"
ConstructorM m a
x <|> :: ConstructorM m a -> ConstructorM m a -> ConstructorM m a
<|> ConstructorM m a
y = ConstructorM m a
x ConstructorM m a
-> (ParamError -> ConstructorM m a) -> ConstructorM m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ParamError -> ConstructorM m a
f
where f :: ParamError -> ConstructorM m a
f (NoParam Identifier
k) = ConstructorM m a
y ConstructorM m a
-> (ParamError -> ConstructorM m a) -> ConstructorM m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` Identifier -> ParamError -> ConstructorM m a
forall (m :: * -> *) a.
Identifier -> ParamError -> ConstructorM m a
g Identifier
k
f (BadValue Identifier
k Value
v) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Bool
true Value
v = ConstructorM m a
y ConstructorM m a
-> (ParamError -> ConstructorM m a) -> ConstructorM m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` Identifier -> ParamError -> ConstructorM m a
forall (m :: * -> *) a.
Identifier -> ParamError -> ConstructorM m a
g Identifier
k
f ParamError
e = ParamError -> ConstructorM m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParamError
e
g :: Identifier -> ParamError -> ConstructorM m a
g Identifier
k1 (NoParam Identifier
_) = Identifier -> ConstructorM m a
forall (m :: * -> *) a. Identifier -> ConstructorM m a
noParam Identifier
k1
g Identifier
_ ParamError
e = ParamError -> ConstructorM m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ParamError
e
instance MonadBackend im => MonadSindre im ConstructorM where
sindre :: Sindre im a -> ConstructorM im a
sindre = ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a
-> ConstructorM im a
forall (m :: * -> *) a.
ErrorT ParamError (StateT (Map Identifier Value) (Sindre m)) a
-> ConstructorM m a
ConstructorM (ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a
-> ConstructorM im a)
-> (Sindre im a
-> ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a)
-> Sindre im a
-> ConstructorM im a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (Map Identifier Value) (Sindre im) a
-> ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Map Identifier Value) (Sindre im) a
-> ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a)
-> (Sindre im a -> StateT (Map Identifier Value) (Sindre im) a)
-> Sindre im a
-> ErrorT ParamError (StateT (Map Identifier Value) (Sindre im)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sindre im a -> StateT (Map Identifier Value) (Sindre im) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance (MonadIO m, MonadBackend m) => MonadIO (ConstructorM m) where
liftIO :: IO a -> ConstructorM m a
liftIO = m a -> ConstructorM m a
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back (m a -> ConstructorM m a)
-> (IO a -> m a) -> IO a -> ConstructorM m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io
paramAs :: MonadBackend m =>
Identifier -> (Value -> Maybe a) -> ConstructorM m a
paramAs :: Identifier -> (Value -> Maybe a) -> ConstructorM m a
paramAs Identifier
k Value -> Maybe a
f = Identifier -> (Value -> m (Maybe a)) -> ConstructorM m a
forall (m :: * -> *) a.
MonadBackend m =>
Identifier -> (Value -> m (Maybe a)) -> ConstructorM m a
paramAsM Identifier
k (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Value -> Maybe a) -> Value -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe a
f)
paramAsM :: MonadBackend m => Identifier
-> (Value -> m (Maybe a)) -> ConstructorM m a
paramAsM :: Identifier -> (Value -> m (Maybe a)) -> ConstructorM m a
paramAsM Identifier
k Value -> m (Maybe a)
mf = do Map Identifier Value
m <- ConstructorM m (Map Identifier Value)
forall s (m :: * -> *). MonadState s m => m s
get
case Identifier -> Map Identifier Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
k Map Identifier Value
m of
Maybe Value
Nothing -> Identifier -> ConstructorM m a
forall (m :: * -> *) a. Identifier -> ConstructorM m a
noParam Identifier
k
Just Value
v -> do Map Identifier Value -> ConstructorM m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Identifier
k Identifier -> Map Identifier Value -> Map Identifier Value
forall k a. Ord k => k -> Map k a -> Map k a
`M.delete` Map Identifier Value
m)
m (Maybe a) -> ConstructorM m (Maybe a)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back (Value -> m (Maybe a)
mf Value
v) ConstructorM m (Maybe a)
-> (Maybe a -> ConstructorM m a) -> ConstructorM m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
ConstructorM m a
-> (a -> ConstructorM m a) -> Maybe a -> ConstructorM m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Identifier -> Value -> ConstructorM m a
forall (m :: * -> *) a. Identifier -> Value -> ConstructorM m a
badValue Identifier
k Value
v) a -> ConstructorM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
paramM :: (Param m a, MonadBackend m) => Identifier -> ConstructorM m a
paramM :: Identifier -> ConstructorM m a
paramM Identifier
k = Identifier -> (Value -> m (Maybe a)) -> ConstructorM m a
forall (m :: * -> *) a.
MonadBackend m =>
Identifier -> (Value -> m (Maybe a)) -> ConstructorM m a
paramAsM Identifier
k Value -> m (Maybe a)
forall (m :: * -> *) a. Param m a => Value -> m (Maybe a)
moldM
param :: (Mold a, MonadBackend m) => Identifier -> ConstructorM m a
param :: Identifier -> ConstructorM m a
param Identifier
k = Identifier -> (Value -> Maybe a) -> ConstructorM m a
forall (m :: * -> *) a.
MonadBackend m =>
Identifier -> (Value -> Maybe a) -> ConstructorM m a
paramAs Identifier
k Value -> Maybe a
forall a. Mold a => Value -> Maybe a
mold