{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Sindre.Runtime ( Sindre
, execSindre
, quitSindre
, MonadSindre(..)
, broadcast
, changed
, redraw
, fullRedraw
, setRootPosition
, MonadBackend(..)
, NewObject
, newObject
, NewWidget
, newWidget
, DataSlot
, instWidget
, instObject
, FieldDesc(..)
, fieldName
, getField
, field
, Field
, Method
, ObjectM
, setFieldByRef
, getFieldByRef
, callMethodByRef
, recvEventByRef
, draw
, compose
, SindreEnv(..)
, newEnv
, globalVal
, setGlobal
, Execution
, execute
, execute_
, returnHere
, doReturn
, nextHere
, doNext
, breakHere
, doBreak
, contHere
, doCont
, setScope
, enterScope
, lexicalVal
, setLexical
, eventLoop
, EventHandler
, Mold(..)
)
where
import Sindre.Parser(parseInteger)
import Sindre.Sindre
import Sindre.Util
import System.Exit
import Control.Applicative
import Control.Monad.Cont
import Control.Monad.Reader
import Control.Monad.State
import Data.Array
import Data.Maybe
import Data.Monoid
import Data.Sequence((|>), ViewL(..))
import qualified Data.IntMap as IM
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Sequence as Q
import qualified Data.Text as T
data FieldDesc s im v = ReadWriteField Identifier (ObjectM s im v) (v -> ObjectM s im ())
| ReadOnlyField Identifier (ObjectM s im v)
fieldName :: FieldDesc s im v -> Identifier
fieldName :: FieldDesc s im v -> Identifier
fieldName (ReadWriteField Identifier
n ObjectM s im v
_ v -> ObjectM s im ()
_) = Identifier
n
fieldName (ReadOnlyField Identifier
n ObjectM s im v
_) = Identifier
n
getField :: FieldDesc s im v -> ObjectM s im v
getField :: FieldDesc s im v -> ObjectM s im v
getField (ReadWriteField Identifier
_ ObjectM s im v
g v -> ObjectM s im ()
_) = ObjectM s im v
g
getField (ReadOnlyField Identifier
_ ObjectM s im v
g) = ObjectM s im v
g
data Field s im = Field { Field s im -> Identifier
fieldID :: Identifier
, Field s im -> ObjectM s im Value
fieldGetter :: ObjectM s im Value
, Field s im -> Value -> ObjectM s im ()
fieldSetter :: Value -> ObjectM s im ()
}
field :: (MonadFail im, Mold v) => FieldDesc s im v -> Field s im
field :: FieldDesc s im v -> Field s im
field (ReadOnlyField Identifier
name ObjectM s im v
bgetter) = Identifier
-> ObjectM s im Value -> (Value -> ObjectM s im ()) -> Field s im
forall s (im :: * -> *).
Identifier
-> ObjectM s im Value -> (Value -> ObjectM s im ()) -> Field s im
Field Identifier
name (v -> Value
forall a. Mold a => a -> Value
unmold (v -> Value) -> ObjectM s im v -> ObjectM s im Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObjectM s im v
bgetter) Value -> ObjectM s im ()
forall b a. b -> ObjectM s im a
problem
where problem :: b -> ObjectM s im a
problem = ObjectM s im a -> b -> ObjectM s im a
forall a b. a -> b -> a
const (ObjectM s im a -> b -> ObjectM s im a)
-> ObjectM s im a -> b -> ObjectM s im a
forall a b. (a -> b) -> a -> b
$ Identifier -> ObjectM s im a
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Field is read-only"
field (ReadWriteField Identifier
name ObjectM s im v
bgetter v -> ObjectM s im ()
bsetter) =
Identifier
-> ObjectM s im Value -> (Value -> ObjectM s im ()) -> Field s im
forall s (im :: * -> *).
Identifier
-> ObjectM s im Value -> (Value -> ObjectM s im ()) -> Field s im
Field Identifier
name (v -> Value
forall a. Mold a => a -> Value
unmold (v -> Value) -> ObjectM s im v -> ObjectM s im Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObjectM s im v
bgetter) Value -> ObjectM s im ()
setter
where setter :: Value -> ObjectM s im ()
setter Value
v = ObjectM s im ()
-> (v -> ObjectM s im ()) -> Maybe v -> ObjectM s im ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ObjectM s im ()
problem v -> ObjectM s im ()
bsetter (Maybe v -> ObjectM s im ()) -> Maybe v -> ObjectM s im ()
forall a b. (a -> b) -> a -> b
$ Value -> Maybe v
forall a. Mold a => Value -> Maybe a
mold Value
v
where problem :: ObjectM s im ()
problem = Identifier -> ObjectM s im ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> ObjectM s im ()) -> Identifier -> ObjectM s im ()
forall a b. (a -> b) -> a -> b
$ Identifier
"Cannot convert " 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
" to expected type"
type Method s im = [Value] -> ObjectM s im Value
data NewWidget im = forall s . NewWidget (Object s im)
(ObjectM s im SpaceNeed)
(Rectangle -> ObjectM s im SpaceUse)
data NewObject im = forall s . NewObject (Object s im)
newWidget :: s
-> M.Map Identifier (Method s im)
-> [Field s im]
-> (Event -> ObjectM s im ())
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im
newWidget :: s
-> Map Identifier (Method s im)
-> [Field s im]
-> (Event -> ObjectM s im ())
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im
newWidget s
s Map Identifier (Method s im)
ms [Field s im]
fs Event -> ObjectM s im ()
h =
Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im
forall (im :: * -> *) s.
Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im
NewWidget (Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im)
-> Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> NewWidget im
forall a b. (a -> b) -> a -> b
$ s
-> Map Identifier (Method s im)
-> Map Identifier (Field s im)
-> (Event -> ObjectM s im ())
-> Object s im
forall s (im :: * -> *).
s
-> Map Identifier (Method s im)
-> Map Identifier (Field s im)
-> (Event -> ObjectM s im ())
-> Object s im
Object s
s Map Identifier (Method s im)
ms ([(Identifier, Field s im)] -> Map Identifier (Field s im)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Field s im)] -> Map Identifier (Field s im))
-> [(Identifier, Field s im)] -> Map Identifier (Field s im)
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Field s im] -> [(Identifier, Field s im)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Field s im -> Identifier) -> [Field s im] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Field s im -> Identifier
forall s (im :: * -> *). Field s im -> Identifier
fieldID [Field s im]
fs) [Field s im]
fs) Event -> ObjectM s im ()
h
newObject :: s
-> M.Map Identifier (Method s im)
-> [Field s im]
-> (Event -> ObjectM s im ())
-> NewObject im
newObject :: s
-> Map Identifier (Method s im)
-> [Field s im]
-> (Event -> ObjectM s im ())
-> NewObject im
newObject s
s Map Identifier (Method s im)
ms [Field s im]
fs Event -> ObjectM s im ()
h =
Object s im -> NewObject im
forall (im :: * -> *) s. Object s im -> NewObject im
NewObject (Object s im -> NewObject im) -> Object s im -> NewObject im
forall a b. (a -> b) -> a -> b
$ s
-> Map Identifier (Method s im)
-> Map Identifier (Field s im)
-> (Event -> ObjectM s im ())
-> Object s im
forall s (im :: * -> *).
s
-> Map Identifier (Method s im)
-> Map Identifier (Field s im)
-> (Event -> ObjectM s im ())
-> Object s im
Object s
s Map Identifier (Method s im)
ms ([(Identifier, Field s im)] -> Map Identifier (Field s im)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Identifier, Field s im)] -> Map Identifier (Field s im))
-> [(Identifier, Field s im)] -> Map Identifier (Field s im)
forall a b. (a -> b) -> a -> b
$ [Identifier] -> [Field s im] -> [(Identifier, Field s im)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Field s im -> Identifier) -> [Field s im] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map Field s im -> Identifier
forall s (im :: * -> *). Field s im -> Identifier
fieldID [Field s im]
fs) [Field s im]
fs) Event -> ObjectM s im ()
h
data Object s im = Object { Object s im -> s
objectState :: s
, Object s im -> Map Identifier (Method s im)
objectMethods :: M.Map Identifier (Method s im)
, Object s im -> Map Identifier (Field s im)
objectFields :: M.Map Identifier (Field s im)
, Object s im -> Event -> ObjectM s im ()
objectHandler :: Event -> ObjectM s im () }
data Widget s im = Widget { Widget s im -> Object s im
widgetObject :: Object s im
, Widget s im -> ObjectM s im SpaceNeed
widgetCompose :: ObjectM s im SpaceNeed
, Widget s im -> Rectangle -> ObjectM s im SpaceUse
widgetDraw :: Rectangle -> ObjectM s im SpaceUse
, Widget s im -> Constraints
widgetConstraints :: Constraints
, Widget s im -> Rectangle
widgetDimensions :: Rectangle }
widgetState :: Widget s im -> s
widgetState :: Widget s im -> s
widgetState = Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState (Object s im -> s)
-> (Widget s im -> Object s im) -> Widget s im -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget s im -> Object s im
forall s (im :: * -> *). Widget s im -> Object s im
widgetObject
data DataSlot im = forall s . WidgetSlot (Widget s im)
| forall s . ObjectSlot (Object s im)
instWidget :: NewWidget im -> Constraints -> DataSlot im
instWidget :: NewWidget im -> Constraints -> DataSlot im
instWidget (NewWidget Object s im
s ObjectM s im SpaceNeed
c Rectangle -> ObjectM s im SpaceUse
d) Constraints
con = Widget s im -> DataSlot im
forall (im :: * -> *) s. Widget s im -> DataSlot im
WidgetSlot (Widget s im -> DataSlot im) -> Widget s im -> DataSlot im
forall a b. (a -> b) -> a -> b
$ Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> Constraints
-> Rectangle
-> Widget s im
forall s (im :: * -> *).
Object s im
-> ObjectM s im SpaceNeed
-> (Rectangle -> ObjectM s im SpaceUse)
-> Constraints
-> Rectangle
-> Widget s im
Widget Object s im
s ObjectM s im SpaceNeed
c Rectangle -> ObjectM s im SpaceUse
d Constraints
con Rectangle
forall a. Monoid a => a
mempty
instObject :: NewObject im -> DataSlot im
instObject :: NewObject im -> DataSlot im
instObject (NewObject Object s im
o) = Object s im -> DataSlot im
forall (im :: * -> *) s. Object s im -> DataSlot im
ObjectSlot Object s im
o
callMethodI :: MonadFail im => Identifier -> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s)
callMethodI :: Identifier
-> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s)
callMethodI Identifier
m [Value]
vs ObjectRef
k Object s im
s = case Identifier -> Map Identifier (Method s im) -> Maybe (Method s im)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
m (Map Identifier (Method s im) -> Maybe (Method s im))
-> Map Identifier (Method s im) -> Maybe (Method s im)
forall a b. (a -> b) -> a -> b
$ Object s im -> Map Identifier (Method s im)
forall s (im :: * -> *).
Object s im -> Map Identifier (Method s im)
objectMethods Object s im
s of
Maybe (Method s im)
Nothing -> Identifier -> Sindre im (Value, s)
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"No such method"
Just Method s im
m' -> ObjectM s im Value -> ObjectRef -> s -> Sindre im (Value, s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Method s im
m' [Value]
vs) ObjectRef
k (s -> Sindre im (Value, s)) -> s -> Sindre im (Value, s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState Object s im
s
getFieldI :: MonadFail im => Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
getFieldI :: Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
getFieldI Identifier
f ObjectRef
k Object s im
s = case Identifier -> Map Identifier (Field s im) -> Maybe (Field s im)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
f (Map Identifier (Field s im) -> Maybe (Field s im))
-> Map Identifier (Field s im) -> Maybe (Field s im)
forall a b. (a -> b) -> a -> b
$ Object s im -> Map Identifier (Field s im)
forall s (im :: * -> *). Object s im -> Map Identifier (Field s im)
objectFields Object s im
s of
Maybe (Field s im)
Nothing -> Identifier -> Sindre im (Value, s)
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"No such field"
Just Field s im
f' -> ObjectM s im Value -> ObjectRef -> s -> Sindre im (Value, s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Field s im -> ObjectM s im Value
forall s (im :: * -> *). Field s im -> ObjectM s im Value
fieldGetter Field s im
f') ObjectRef
k (s -> Sindre im (Value, s)) -> s -> Sindre im (Value, s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState Object s im
s
setFieldI :: MonadFail im => Identifier -> Value -> ObjectRef -> Object s im -> Sindre im (Value, s)
setFieldI :: Identifier
-> Value -> ObjectRef -> Object s im -> Sindre im (Value, s)
setFieldI Identifier
f Value
v ObjectRef
k Object s im
s = case Identifier -> Map Identifier (Field s im) -> Maybe (Field s im)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Identifier
f (Map Identifier (Field s im) -> Maybe (Field s im))
-> Map Identifier (Field s im) -> Maybe (Field s im)
forall a b. (a -> b) -> a -> b
$ Object s im -> Map Identifier (Field s im)
forall s (im :: * -> *). Object s im -> Map Identifier (Field s im)
objectFields Object s im
s of
Maybe (Field s im)
Nothing -> Identifier -> Sindre im (Value, s)
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"No such field"
Just Field s im
f' -> ObjectM s im Value -> ObjectRef -> s -> Sindre im (Value, s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Field s im -> ObjectM s im Value
setget Field s im
f') ObjectRef
k (s -> Sindre im (Value, s)) -> s -> Sindre im (Value, s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState Object s im
s
where setget :: Field s im -> ObjectM s im Value
setget Field s im
f' = Field s im -> Value -> ObjectM s im ()
forall s (im :: * -> *). Field s im -> Value -> ObjectM s im ()
fieldSetter Field s im
f' Value
v ObjectM s im () -> ObjectM s im Value -> ObjectM s im Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Field s im -> ObjectM s im Value
forall s (im :: * -> *). Field s im -> ObjectM s im Value
fieldGetter Field s im
f'
recvEventI :: Event -> ObjectRef -> Object s im -> Sindre im ((), s)
recvEventI :: Event -> ObjectRef -> Object s im -> Sindre im ((), s)
recvEventI Event
e ObjectRef
k Object s im
s = ObjectM s im () -> ObjectRef -> s -> Sindre im ((), s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Object s im -> Event -> ObjectM s im ()
forall s (im :: * -> *). Object s im -> Event -> ObjectM s im ()
objectHandler Object s im
s Event
e) ObjectRef
k (s -> Sindre im ((), s)) -> s -> Sindre im ((), s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState Object s im
s
composeI :: ObjectRef -> Widget s im -> Sindre im (SpaceNeed, s)
composeI :: ObjectRef -> Widget s im -> Sindre im (SpaceNeed, s)
composeI ObjectRef
k Widget s im
s = ObjectM s im SpaceNeed
-> ObjectRef -> s -> Sindre im (SpaceNeed, s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Widget s im -> ObjectM s im SpaceNeed
forall s (im :: * -> *). Widget s im -> ObjectM s im SpaceNeed
widgetCompose Widget s im
s) ObjectRef
k (s -> Sindre im (SpaceNeed, s)) -> s -> Sindre im (SpaceNeed, s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState (Object s im -> s) -> Object s im -> s
forall a b. (a -> b) -> a -> b
$ Widget s im -> Object s im
forall s (im :: * -> *). Widget s im -> Object s im
widgetObject Widget s im
s
drawI :: Rectangle -> ObjectRef -> Widget s im -> Sindre im (SpaceUse, s)
drawI :: Rectangle -> ObjectRef -> Widget s im -> Sindre im (SpaceUse, s)
drawI Rectangle
r ObjectRef
k Widget s im
s = ObjectM s im SpaceUse -> ObjectRef -> s -> Sindre im (SpaceUse, s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Widget s im -> Rectangle -> ObjectM s im SpaceUse
forall s (im :: * -> *).
Widget s im -> Rectangle -> ObjectM s im SpaceUse
widgetDraw Widget s im
s Rectangle
r) ObjectRef
k (s -> Sindre im (SpaceUse, s)) -> s -> Sindre im (SpaceUse, s)
forall a b. (a -> b) -> a -> b
$ Widget s im -> s
forall s (im :: * -> *). Widget s im -> s
widgetState Widget s im
s
type Frame = IM.IntMap Value
data Redraw = RedrawAll | RedrawSome (S.Set WidgetRef)
data SindreEnv m = SindreEnv {
SindreEnv m -> Array ObjectNum (DataSlot m)
objects :: Array ObjectNum (DataSlot m)
, SindreEnv m -> Seq Event
evtQueue :: Q.Seq Event
, SindreEnv m -> IntMap Value
globals :: IM.IntMap Value
, SindreEnv m -> IntMap Value
execFrame :: Frame
, SindreEnv m -> ObjectRef
kbdFocus :: WidgetRef
, SindreEnv m -> (Maybe (RootPosition m), ObjectRef)
rootWidget :: (Maybe (RootPosition m), WidgetRef)
, SindreEnv m -> Arguments
arguments :: Arguments
, SindreEnv m -> Redraw
needsRedraw :: Redraw
}
newEnv :: WidgetRef -> Arguments -> SindreEnv m
newEnv :: ObjectRef -> Arguments -> SindreEnv m
newEnv ObjectRef
rootwr Arguments
argv =
SindreEnv :: forall (m :: * -> *).
Array ObjectNum (DataSlot m)
-> Seq Event
-> IntMap Value
-> IntMap Value
-> ObjectRef
-> (Maybe (RootPosition m), ObjectRef)
-> Arguments
-> Redraw
-> SindreEnv m
SindreEnv { objects :: Array ObjectNum (DataSlot m)
objects = (ObjectNum, ObjectNum)
-> [(ObjectNum, DataSlot m)] -> Array ObjectNum (DataSlot m)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (ObjectNum
0, -ObjectNum
1) []
, evtQueue :: Seq Event
evtQueue = Seq Event
forall a. Seq a
Q.empty
, globals :: IntMap Value
globals = IntMap Value
forall a. IntMap a
IM.empty
, execFrame :: IntMap Value
execFrame = IntMap Value
forall a. IntMap a
IM.empty
, kbdFocus :: ObjectRef
kbdFocus = ObjectRef
rootwr
, rootWidget :: (Maybe (RootPosition m), ObjectRef)
rootWidget = (Maybe (RootPosition m)
forall a. Maybe a
Nothing, ObjectRef
rootwr)
, arguments :: Arguments
arguments = Arguments
argv
, needsRedraw :: Redraw
needsRedraw = Redraw
RedrawAll
}
class (MonadIO m, MonadFail m, Mold (RootPosition m)) => MonadBackend m where
type BackEvent m :: *
type RootPosition m :: *
redrawRoot :: Sindre m ()
redrawRegion :: [Rectangle] -> Sindre m ()
getBackEvent :: Sindre m (Maybe Event)
waitForBackEvent :: Sindre m Event
printVal :: String -> m ()
type QuitFun m = ExitCode -> Sindre m ()
newtype Sindre m a = Sindre (ReaderT (QuitFun m)
(StateT (SindreEnv m)
(ContT ExitCode m))
a)
deriving (a -> Sindre m b -> Sindre m a
(a -> b) -> Sindre m a -> Sindre m b
(forall a b. (a -> b) -> Sindre m a -> Sindre m b)
-> (forall a b. a -> Sindre m b -> Sindre m a)
-> Functor (Sindre m)
forall a b. a -> Sindre m b -> Sindre m a
forall a b. (a -> b) -> Sindre m a -> Sindre 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 -> Sindre m b -> Sindre m a
forall (m :: * -> *) a b. (a -> b) -> Sindre m a -> Sindre m b
<$ :: a -> Sindre m b -> Sindre m a
$c<$ :: forall (m :: * -> *) a b. a -> Sindre m b -> Sindre m a
fmap :: (a -> b) -> Sindre m a -> Sindre m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> Sindre m a -> Sindre m b
Functor, Applicative (Sindre m)
a -> Sindre m a
Applicative (Sindre m)
-> (forall a b. Sindre m a -> (a -> Sindre m b) -> Sindre m b)
-> (forall a b. Sindre m a -> Sindre m b -> Sindre m b)
-> (forall a. a -> Sindre m a)
-> Monad (Sindre m)
Sindre m a -> (a -> Sindre m b) -> Sindre m b
Sindre m a -> Sindre m b -> Sindre m b
forall a. a -> Sindre m a
forall a b. Sindre m a -> Sindre m b -> Sindre m b
forall a b. Sindre m a -> (a -> Sindre m b) -> Sindre m b
forall (m :: * -> *). Applicative (Sindre 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 -> Sindre m a
forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m b
forall (m :: * -> *) a b.
Sindre m a -> (a -> Sindre m b) -> Sindre m b
return :: a -> Sindre m a
$creturn :: forall (m :: * -> *) a. a -> Sindre m a
>> :: Sindre m a -> Sindre m b -> Sindre m b
$c>> :: forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m b
>>= :: Sindre m a -> (a -> Sindre m b) -> Sindre m b
$c>>= :: forall (m :: * -> *) a b.
Sindre m a -> (a -> Sindre m b) -> Sindre m b
$cp1Monad :: forall (m :: * -> *). Applicative (Sindre m)
Monad, Functor (Sindre m)
a -> Sindre m a
Functor (Sindre m)
-> (forall a. a -> Sindre m a)
-> (forall a b. Sindre m (a -> b) -> Sindre m a -> Sindre m b)
-> (forall a b c.
(a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c)
-> (forall a b. Sindre m a -> Sindre m b -> Sindre m b)
-> (forall a b. Sindre m a -> Sindre m b -> Sindre m a)
-> Applicative (Sindre m)
Sindre m a -> Sindre m b -> Sindre m b
Sindre m a -> Sindre m b -> Sindre m a
Sindre m (a -> b) -> Sindre m a -> Sindre m b
(a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c
forall a. a -> Sindre m a
forall a b. Sindre m a -> Sindre m b -> Sindre m a
forall a b. Sindre m a -> Sindre m b -> Sindre m b
forall a b. Sindre m (a -> b) -> Sindre m a -> Sindre m b
forall a b c.
(a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c
forall (m :: * -> *). Functor (Sindre 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 -> Sindre m a
forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m a
forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m b
forall (m :: * -> *) a b.
Sindre m (a -> b) -> Sindre m a -> Sindre m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c
<* :: Sindre m a -> Sindre m b -> Sindre m a
$c<* :: forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m a
*> :: Sindre m a -> Sindre m b -> Sindre m b
$c*> :: forall (m :: * -> *) a b. Sindre m a -> Sindre m b -> Sindre m b
liftA2 :: (a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> Sindre m a -> Sindre m b -> Sindre m c
<*> :: Sindre m (a -> b) -> Sindre m a -> Sindre m b
$c<*> :: forall (m :: * -> *) a b.
Sindre m (a -> b) -> Sindre m a -> Sindre m b
pure :: a -> Sindre m a
$cpure :: forall (m :: * -> *) a. a -> Sindre m a
$cp1Applicative :: forall (m :: * -> *). Functor (Sindre m)
Applicative, Monad (Sindre m)
Monad (Sindre m)
-> (forall a. Identifier -> Sindre m a) -> MonadFail (Sindre m)
Identifier -> Sindre m a
forall a. Identifier -> Sindre m a
forall (m :: * -> *).
Monad m -> (forall a. Identifier -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (Sindre m)
forall (m :: * -> *) a. MonadFail m => Identifier -> Sindre m a
fail :: Identifier -> Sindre m a
$cfail :: forall (m :: * -> *) a. MonadFail m => Identifier -> Sindre m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (Sindre m)
MonadFail, Monad (Sindre m)
Monad (Sindre m)
-> (forall a b. ((a -> Sindre m b) -> Sindre m a) -> Sindre m a)
-> MonadCont (Sindre m)
((a -> Sindre m b) -> Sindre m a) -> Sindre m a
forall a b. ((a -> Sindre m b) -> Sindre m a) -> Sindre m a
forall (m :: * -> *). Monad (Sindre m)
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall (m :: * -> *) a b.
((a -> Sindre m b) -> Sindre m a) -> Sindre m a
callCC :: ((a -> Sindre m b) -> Sindre m a) -> Sindre m a
$ccallCC :: forall (m :: * -> *) a b.
((a -> Sindre m b) -> Sindre m a) -> Sindre m a
$cp1MonadCont :: forall (m :: * -> *). Monad (Sindre m)
MonadCont,
MonadState (SindreEnv m), MonadReader (QuitFun m))
instance MonadTrans Sindre where
lift :: m a -> Sindre m a
lift = ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a
forall (m :: * -> *) a.
ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a
Sindre (ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a)
-> (m a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a)
-> m a
-> Sindre m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (SindreEnv m) (ContT ExitCode m) a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (SindreEnv m) (ContT ExitCode m) a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a)
-> (m a -> StateT (SindreEnv m) (ContT ExitCode m) a)
-> m a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContT ExitCode m a -> StateT (SindreEnv m) (ContT ExitCode m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ContT ExitCode m a -> StateT (SindreEnv m) (ContT ExitCode m) a)
-> (m a -> ContT ExitCode m a)
-> m a
-> StateT (SindreEnv m) (ContT ExitCode m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ContT ExitCode m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadIO m => MonadIO (Sindre m) where
liftIO :: IO a -> Sindre m a
liftIO = ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a
forall (m :: * -> *) a.
ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a
Sindre (ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a)
-> (IO a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a)
-> IO a
-> Sindre m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance Monoid (Sindre m ()) where
mempty :: Sindre m ()
mempty = () -> Sindre m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mconcat :: [Sindre m ()] -> Sindre m ()
mconcat = [Sindre m ()] -> Sindre m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
instance Semigroup (Sindre m ()) where
<> :: Sindre m () -> Sindre m () -> Sindre m ()
(<>) = Sindre m () -> Sindre m () -> Sindre m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>)
execSindre :: MonadBackend m => SindreEnv m -> Sindre m a -> m ExitCode
execSindre :: SindreEnv m -> Sindre m a -> m ExitCode
execSindre SindreEnv m
s (Sindre ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
m) = ContT ExitCode m ExitCode -> (ExitCode -> m ExitCode) -> m ExitCode
forall k (r :: k) (m :: k -> *) a. ContT r m a -> (a -> m r) -> m r
runContT ContT ExitCode m ExitCode
m' ExitCode -> m ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return
where m' :: ContT ExitCode m ExitCode
m' = ((ExitCode -> ContT ExitCode m ()) -> ContT ExitCode m ExitCode)
-> ContT ExitCode m ExitCode
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (((ExitCode -> ContT ExitCode m ()) -> ContT ExitCode m ExitCode)
-> ContT ExitCode m ExitCode)
-> ((ExitCode -> ContT ExitCode m ()) -> ContT ExitCode m ExitCode)
-> ContT ExitCode m ExitCode
forall a b. (a -> b) -> a -> b
$ \ExitCode -> ContT ExitCode m ()
c -> do
let quitc :: QuitFun m
quitc ExitCode
code =
ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ()
-> Sindre m ()
forall (m :: * -> *) a.
ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> Sindre m a
Sindre (ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ()
-> Sindre m ())
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ()
-> Sindre m ()
forall a b. (a -> b) -> a -> b
$ StateT (SindreEnv m) (ContT ExitCode m) ()
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (SindreEnv m) (ContT ExitCode m) ()
-> ReaderT
(QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ())
-> StateT (SindreEnv m) (ContT ExitCode m) ()
-> ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) ()
forall a b. (a -> b) -> a -> b
$ ContT ExitCode m () -> StateT (SindreEnv m) (ContT ExitCode m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ContT ExitCode m () -> StateT (SindreEnv m) (ContT ExitCode m) ())
-> ContT ExitCode m ()
-> StateT (SindreEnv m) (ContT ExitCode m) ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> ContT ExitCode m ()
c ExitCode
code
SindreEnv m
_ <- StateT (SindreEnv m) (ContT ExitCode m) a
-> SindreEnv m -> ContT ExitCode m (SindreEnv m)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
-> QuitFun m -> StateT (SindreEnv m) (ContT ExitCode m) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (QuitFun m) (StateT (SindreEnv m) (ContT ExitCode m)) a
m QuitFun m
quitc) SindreEnv m
s
ExitCode -> ContT ExitCode m ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
quitSindre :: MonadBackend m => ExitCode -> Sindre m ()
quitSindre :: ExitCode -> Sindre m ()
quitSindre ExitCode
code = ((ExitCode -> Sindre m ()) -> ExitCode -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ ExitCode
code) ((ExitCode -> Sindre m ()) -> Sindre m ())
-> Sindre m (ExitCode -> Sindre m ()) -> Sindre m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sindre m (ExitCode -> Sindre m ())
forall r (m :: * -> *). MonadReader r m => m r
ask
class (MonadBackend im, MonadFail (m im), MonadFail im) => MonadSindre im m where
sindre :: Sindre im a -> m im a
back :: im a -> m im a
back = Sindre im a -> m im a
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im a -> m im a) -> (im a -> Sindre im a) -> im a -> m im a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. im a -> Sindre im a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadBackend im => MonadSindre im Sindre where
sindre :: Sindre im a -> Sindre im a
sindre = Sindre im a -> Sindre im a
forall a. a -> a
id
newtype ObjectM s im a = ObjectM (ReaderT ObjectRef (StateT s (Sindre im)) a)
deriving (a -> ObjectM s im b -> ObjectM s im a
(a -> b) -> ObjectM s im a -> ObjectM s im b
(forall a b. (a -> b) -> ObjectM s im a -> ObjectM s im b)
-> (forall a b. a -> ObjectM s im b -> ObjectM s im a)
-> Functor (ObjectM s im)
forall a b. a -> ObjectM s im b -> ObjectM s im a
forall a b. (a -> b) -> ObjectM s im a -> ObjectM s im b
forall s (im :: * -> *) a b. a -> ObjectM s im b -> ObjectM s im a
forall s (im :: * -> *) a b.
(a -> b) -> ObjectM s im a -> ObjectM s im b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ObjectM s im b -> ObjectM s im a
$c<$ :: forall s (im :: * -> *) a b. a -> ObjectM s im b -> ObjectM s im a
fmap :: (a -> b) -> ObjectM s im a -> ObjectM s im b
$cfmap :: forall s (im :: * -> *) a b.
(a -> b) -> ObjectM s im a -> ObjectM s im b
Functor, Applicative (ObjectM s im)
a -> ObjectM s im a
Applicative (ObjectM s im)
-> (forall a b.
ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b)
-> (forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im b)
-> (forall a. a -> ObjectM s im a)
-> Monad (ObjectM s im)
ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
forall a. a -> ObjectM s im a
forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im b
forall a b.
ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b
forall s (im :: * -> *). Applicative (ObjectM s im)
forall s (im :: * -> *) a. a -> ObjectM s im a
forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
forall s (im :: * -> *) a b.
ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b
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
return :: a -> ObjectM s im a
$creturn :: forall s (im :: * -> *) a. a -> ObjectM s im a
>> :: ObjectM s im a -> ObjectM s im b -> ObjectM s im b
$c>> :: forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
>>= :: ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b
$c>>= :: forall s (im :: * -> *) a b.
ObjectM s im a -> (a -> ObjectM s im b) -> ObjectM s im b
$cp1Monad :: forall s (im :: * -> *). Applicative (ObjectM s im)
Monad, Monad (ObjectM s im)
Monad (ObjectM s im)
-> (forall a. Identifier -> ObjectM s im a)
-> MonadFail (ObjectM s im)
Identifier -> ObjectM s im a
forall a. Identifier -> ObjectM s im a
forall s (im :: * -> *). MonadFail im => Monad (ObjectM s im)
forall s (im :: * -> *) a.
MonadFail im =>
Identifier -> ObjectM s im a
forall (m :: * -> *).
Monad m -> (forall a. Identifier -> m a) -> MonadFail m
fail :: Identifier -> ObjectM s im a
$cfail :: forall s (im :: * -> *) a.
MonadFail im =>
Identifier -> ObjectM s im a
$cp1MonadFail :: forall s (im :: * -> *). MonadFail im => Monad (ObjectM s im)
MonadFail, Functor (ObjectM s im)
a -> ObjectM s im a
Functor (ObjectM s im)
-> (forall a. a -> ObjectM s im a)
-> (forall a b.
ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b)
-> (forall a b c.
(a -> b -> c)
-> ObjectM s im a -> ObjectM s im b -> ObjectM s im c)
-> (forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im b)
-> (forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im a)
-> Applicative (ObjectM s im)
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
ObjectM s im a -> ObjectM s im b -> ObjectM s im a
ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b
(a -> b -> c) -> ObjectM s im a -> ObjectM s im b -> ObjectM s im c
forall a. a -> ObjectM s im a
forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im a
forall a b. ObjectM s im a -> ObjectM s im b -> ObjectM s im b
forall a b.
ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b
forall a b c.
(a -> b -> c) -> ObjectM s im a -> ObjectM s im b -> ObjectM s im c
forall s (im :: * -> *). Functor (ObjectM s im)
forall s (im :: * -> *) a. a -> ObjectM s im a
forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im a
forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
forall s (im :: * -> *) a b.
ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b
forall s (im :: * -> *) a b c.
(a -> b -> c) -> ObjectM s im a -> ObjectM s im b -> ObjectM s im c
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
<* :: ObjectM s im a -> ObjectM s im b -> ObjectM s im a
$c<* :: forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im a
*> :: ObjectM s im a -> ObjectM s im b -> ObjectM s im b
$c*> :: forall s (im :: * -> *) a b.
ObjectM s im a -> ObjectM s im b -> ObjectM s im b
liftA2 :: (a -> b -> c) -> ObjectM s im a -> ObjectM s im b -> ObjectM s im c
$cliftA2 :: forall s (im :: * -> *) a b c.
(a -> b -> c) -> ObjectM s im a -> ObjectM s im b -> ObjectM s im c
<*> :: ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b
$c<*> :: forall s (im :: * -> *) a b.
ObjectM s im (a -> b) -> ObjectM s im a -> ObjectM s im b
pure :: a -> ObjectM s im a
$cpure :: forall s (im :: * -> *) a. a -> ObjectM s im a
$cp1Applicative :: forall s (im :: * -> *). Functor (ObjectM s im)
Applicative, MonadState s, MonadReader ObjectRef)
instance MonadBackend im => MonadSindre im (ObjectM o) where
sindre :: Sindre im a -> ObjectM o im a
sindre = ReaderT ObjectRef (StateT o (Sindre im)) a -> ObjectM o im a
forall s (im :: * -> *) a.
ReaderT ObjectRef (StateT s (Sindre im)) a -> ObjectM s im a
ObjectM (ReaderT ObjectRef (StateT o (Sindre im)) a -> ObjectM o im a)
-> (Sindre im a -> ReaderT ObjectRef (StateT o (Sindre im)) a)
-> Sindre im a
-> ObjectM o im a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT o (Sindre im) a
-> ReaderT ObjectRef (StateT o (Sindre im)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT o (Sindre im) a
-> ReaderT ObjectRef (StateT o (Sindre im)) a)
-> (Sindre im a -> StateT o (Sindre im) a)
-> Sindre im a
-> ReaderT ObjectRef (StateT o (Sindre im)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sindre im a -> StateT o (Sindre im) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runObjectM :: ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM :: ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (ObjectM ReaderT ObjectRef (StateT s (Sindre im)) a
m) ObjectRef
wr = StateT s (Sindre im) a -> s -> Sindre im (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT ObjectRef (StateT s (Sindre im)) a
-> ObjectRef -> StateT s (Sindre im) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ObjectRef (StateT s (Sindre im)) a
m ObjectRef
wr)
instance (MonadIO m, MonadBackend m) => MonadIO (ObjectM o m) where
liftIO :: IO a -> ObjectM o m a
liftIO = Sindre m a -> ObjectM o m a
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m a -> ObjectM o m a)
-> (IO a -> Sindre m a) -> IO a -> ObjectM o m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Sindre m a
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
im a -> m im a
back (m a -> Sindre m a) -> (IO a -> m a) -> IO a -> Sindre 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
popQueue :: Sindre m (Maybe Event)
popQueue :: Sindre m (Maybe Event)
popQueue = do Seq Event
queue <- (SindreEnv m -> Seq Event) -> Sindre m (Seq Event)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv m -> Seq Event
forall (m :: * -> *). SindreEnv m -> Seq Event
evtQueue
case Seq Event -> ViewL Event
forall a. Seq a -> ViewL a
Q.viewl Seq Event
queue of
Event
e :< Seq Event
queue' -> do (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 { evtQueue :: Seq Event
evtQueue = Seq Event
queue' }
Maybe Event -> Sindre m (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Event -> Sindre m (Maybe Event))
-> Maybe Event -> Sindre m (Maybe Event)
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e
ViewL Event
EmptyL -> Maybe Event -> Sindre m (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Event
forall a. Maybe a
Nothing
getEvent :: MonadBackend m => Sindre m (Maybe Event)
getEvent :: Sindre m (Maybe Event)
getEvent = Sindre m (Maybe Event)
-> (Event -> Sindre m (Maybe Event))
-> Maybe Event
-> Sindre m (Maybe Event)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sindre m (Maybe Event)
forall (m :: * -> *). Sindre m (Maybe Event)
popQueue (Maybe Event -> Sindre m (Maybe Event)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Event -> Sindre m (Maybe Event))
-> (Event -> Maybe Event) -> Event -> Sindre m (Maybe Event)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Maybe Event
forall a. a -> Maybe a
Just) (Maybe Event -> Sindre m (Maybe Event))
-> Sindre m (Maybe Event) -> Sindre m (Maybe Event)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sindre m (Maybe Event)
forall (m :: * -> *). MonadBackend m => Sindre m (Maybe Event)
getBackEvent
waitForEvent :: MonadBackend m => Sindre m Event
waitForEvent :: Sindre m Event
waitForEvent = Sindre m Event
-> (Event -> Sindre m Event) -> Maybe Event -> Sindre m Event
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sindre m Event
forall (m :: * -> *). MonadBackend m => Sindre m Event
waitForBackEvent Event -> Sindre m Event
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Event -> Sindre m Event)
-> Sindre m (Maybe Event) -> Sindre m Event
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sindre m (Maybe Event)
forall (m :: * -> *). Sindre m (Maybe Event)
popQueue
broadcast :: MonadBackend im => Event -> ObjectM o im ()
broadcast :: Event -> ObjectM o im ()
broadcast Event
e = Sindre im () -> ObjectM o im ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im () -> ObjectM o im ())
-> Sindre im () -> ObjectM o im ()
forall a b. (a -> b) -> a -> b
$ (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv im -> SindreEnv im) -> Sindre im ())
-> (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv im
s -> SindreEnv im
s { evtQueue :: Seq Event
evtQueue = SindreEnv im -> Seq Event
forall (m :: * -> *). SindreEnv m -> Seq Event
evtQueue SindreEnv im
s Seq Event -> Event -> Seq Event
forall a. Seq a -> a -> Seq a
|> Event
e }
changed :: MonadBackend im =>
Identifier -> Value -> Value -> ObjectM o im ()
changed :: Identifier -> Value -> Value -> ObjectM o im ()
changed Identifier
f Value
old Value
new = do
ObjectRef
this <- ObjectM o im ObjectRef
forall r (m :: * -> *). MonadReader r m => m r
ask
Event -> ObjectM o im ()
forall (im :: * -> *) o.
MonadBackend im =>
Event -> ObjectM o im ()
broadcast (Event -> ObjectM o im ()) -> Event -> ObjectM o im ()
forall a b. (a -> b) -> a -> b
$ Identifier -> [Value] -> EventSource -> Event
NamedEvent Identifier
"changed" [Value
old, Value
new] (EventSource -> Event) -> EventSource -> Event
forall a b. (a -> b) -> a -> b
$ ObjectRef -> Identifier -> EventSource
FieldSrc ObjectRef
this Identifier
f
redraw :: MonadBackend im => ObjectM s im ()
redraw :: ObjectM s im ()
redraw = do ObjectRef
r <- ObjectM s im ObjectRef
forall r (m :: * -> *). MonadReader r m => m r
ask
Sindre im () -> ObjectM s im ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im () -> ObjectM s im ())
-> Sindre im () -> ObjectM s im ()
forall a b. (a -> b) -> a -> b
$ (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv im -> SindreEnv im) -> Sindre im ())
-> (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv im
s ->
SindreEnv im
s { needsRedraw :: Redraw
needsRedraw = SindreEnv im -> Redraw
forall (m :: * -> *). SindreEnv m -> Redraw
needsRedraw SindreEnv im
s Redraw -> ObjectRef -> Redraw
`add` ObjectRef
r }
ObjectM s im ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *).
MonadSindre im m =>
m im ()
fullRedraw
where add :: Redraw -> ObjectRef -> Redraw
add Redraw
RedrawAll ObjectRef
_ = Redraw
RedrawAll
add (RedrawSome Set ObjectRef
s) ObjectRef
w = Set ObjectRef -> Redraw
RedrawSome (Set ObjectRef -> Redraw) -> Set ObjectRef -> Redraw
forall a b. (a -> b) -> a -> b
$ ObjectRef
w ObjectRef -> Set ObjectRef -> Set ObjectRef
forall a. Ord a => a -> Set a -> Set a
`S.insert` Set ObjectRef
s
fullRedraw :: MonadSindre im m => m im ()
fullRedraw :: m im ()
fullRedraw = Sindre im () -> m im ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im () -> m im ()) -> Sindre im () -> m im ()
forall a b. (a -> b) -> a -> b
$ (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv im -> SindreEnv im) -> Sindre im ())
-> (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv im
s ->
case SindreEnv im -> Redraw
forall (m :: * -> *). SindreEnv m -> Redraw
needsRedraw SindreEnv im
s of
Redraw
RedrawAll -> SindreEnv im
s
Redraw
_ -> SindreEnv im
s { needsRedraw :: Redraw
needsRedraw = Redraw
RedrawAll }
setRootPosition :: MonadBackend m => Value -> Sindre m ()
setRootPosition :: Value -> Sindre m ()
setRootPosition Value
v =
case Value -> Maybe (RootPosition m)
forall a. Mold a => Value -> Maybe a
mold Value
v of
Maybe (RootPosition m)
Nothing -> Identifier -> Sindre m ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail (Identifier -> Sindre m ()) -> Identifier -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ Identifier
"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
" not a valid root widget position."
Just RootPosition m
v' -> (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 { rootWidget :: (Maybe (RootPosition m), ObjectRef)
rootWidget = (RootPosition m -> Maybe (RootPosition m)
forall a. a -> Maybe a
Just RootPosition m
v', (Maybe (RootPosition m), ObjectRef) -> ObjectRef
forall a b. (a, b) -> b
snd ((Maybe (RootPosition m), ObjectRef) -> ObjectRef)
-> (Maybe (RootPosition m), ObjectRef) -> ObjectRef
forall a b. (a -> b) -> a -> b
$ SindreEnv m -> (Maybe (RootPosition m), ObjectRef)
forall (m :: * -> *).
SindreEnv m -> (Maybe (RootPosition m), ObjectRef)
rootWidget SindreEnv m
s) }
globalVal :: MonadBackend m => IM.Key -> Sindre m Value
globalVal :: ObjectNum -> Sindre m Value
globalVal ObjectNum
k = Value -> ObjectNum -> IntMap Value -> Value
forall a. a -> ObjectNum -> IntMap a -> a
IM.findWithDefault Value
falsity ObjectNum
k (IntMap Value -> Value)
-> Sindre m (IntMap Value) -> Sindre m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
globals
setGlobal :: MonadBackend m => IM.Key -> Value -> Sindre m ()
setGlobal :: ObjectNum -> Value -> Sindre m ()
setGlobal ObjectNum
k Value
v =
(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 { globals :: IntMap Value
globals = ObjectNum -> Value -> IntMap Value -> IntMap Value
forall a. ObjectNum -> a -> IntMap a -> IntMap a
IM.insert ObjectNum
k Value
v (IntMap Value -> IntMap Value) -> IntMap Value -> IntMap Value
forall a b. (a -> b) -> a -> b
$ SindreEnv m -> IntMap Value
forall (m :: * -> *). SindreEnv m -> IntMap Value
globals SindreEnv m
s }
compose :: MonadSindre im m => WidgetRef -> m im SpaceNeed
compose :: ObjectRef -> m im SpaceNeed
compose ObjectRef
k = Sindre im SpaceNeed -> m im SpaceNeed
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im SpaceNeed -> m im SpaceNeed)
-> Sindre im SpaceNeed -> m im SpaceNeed
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Widget s im -> Sindre im (SpaceNeed, Widget s im))
-> Sindre im SpaceNeed
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Widget s im -> Sindre im (a, Widget s im))
-> Sindre im a
operateW ObjectRef
k ((forall s. Widget s im -> Sindre im (SpaceNeed, Widget s im))
-> Sindre im SpaceNeed)
-> (forall s. Widget s im -> Sindre im (SpaceNeed, Widget s im))
-> Sindre im SpaceNeed
forall a b. (a -> b) -> a -> b
$ \Widget s im
w -> do
(SpaceNeed
need, Widget s im
w') <- (Widget s im -> Sindre im (SpaceNeed, s))
-> Widget s im -> Sindre im (SpaceNeed, Widget s im)
forall s (im :: * -> *) a.
(Widget s im -> Sindre im (a, s))
-> Widget s im -> Sindre im (a, Widget s im)
onStateW (ObjectRef -> Widget s im -> Sindre im (SpaceNeed, s)
forall s (im :: * -> *).
ObjectRef -> Widget s im -> Sindre im (SpaceNeed, s)
composeI ObjectRef
k) Widget s im
w
(SpaceNeed, Widget s im) -> Sindre im (SpaceNeed, Widget s im)
forall (m :: * -> *) a. Monad m => a -> m a
return (SpaceNeed -> Constraints -> SpaceNeed
constrainNeed SpaceNeed
need (Constraints -> SpaceNeed) -> Constraints -> SpaceNeed
forall a b. (a -> b) -> a -> b
$ Widget s im -> Constraints
forall s (im :: * -> *). Widget s im -> Constraints
widgetConstraints Widget s im
w', Widget s im
w')
draw :: MonadSindre im m =>
WidgetRef -> Maybe Rectangle -> m im SpaceUse
draw :: ObjectRef -> Maybe Rectangle -> m im SpaceUse
draw ObjectRef
k Maybe Rectangle
rect = Sindre im SpaceUse -> m im SpaceUse
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im SpaceUse -> m im SpaceUse)
-> Sindre im SpaceUse -> m im SpaceUse
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Widget s im -> Sindre im (SpaceUse, Widget s im))
-> Sindre im SpaceUse
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Widget s im -> Sindre im (a, Widget s im))
-> Sindre im a
operateW ObjectRef
k ((forall s. Widget s im -> Sindre im (SpaceUse, Widget s im))
-> Sindre im SpaceUse)
-> (forall s. Widget s im -> Sindre im (SpaceUse, Widget s im))
-> Sindre im SpaceUse
forall a b. (a -> b) -> a -> b
$ \Widget s im
w -> do
let rect' :: Rectangle
rect' = Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Widget s im -> Rectangle
forall s (im :: * -> *). Widget s im -> Rectangle
widgetDimensions Widget s im
w) Maybe Rectangle
rect
(SpaceUse
use, Widget s im
w') <- (Widget s im -> Sindre im (SpaceUse, s))
-> Widget s im -> Sindre im (SpaceUse, Widget s im)
forall s (im :: * -> *) a.
(Widget s im -> Sindre im (a, s))
-> Widget s im -> Sindre im (a, Widget s im)
onStateW (Rectangle -> ObjectRef -> Widget s im -> Sindre im (SpaceUse, s)
forall s (im :: * -> *).
Rectangle -> ObjectRef -> Widget s im -> Sindre im (SpaceUse, s)
drawI Rectangle
rect' ObjectRef
k) Widget s im
w
(SpaceUse, Widget s im) -> Sindre im (SpaceUse, Widget s im)
forall (m :: * -> *) a. Monad m => a -> m a
return (SpaceUse
use, Widget s im
w' { widgetDimensions :: Rectangle
widgetDimensions = Rectangle
rect' })
type Jumper m a = a -> Execution m ()
data ExecutionEnv m = ExecutionEnv {
ExecutionEnv m -> Jumper m Value
execReturn :: Jumper m Value
, ExecutionEnv m -> Jumper m ()
execNext :: Jumper m ()
, ExecutionEnv m -> Jumper m ()
execBreak :: Jumper m ()
, ExecutionEnv m -> Jumper m ()
execCont :: Jumper m ()
}
setJump :: MonadBackend m =>
(Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump :: (Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump Jumper m a -> ExecutionEnv m -> ExecutionEnv m
f Execution m a
m = (Jumper m a -> Execution m a) -> Execution m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC ((Jumper m a -> Execution m a) -> Execution m a)
-> (Jumper m a -> Execution m a) -> Execution m a
forall a b. (a -> b) -> a -> b
$ ((ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a)
-> Execution m a
-> (ExecutionEnv m -> ExecutionEnv m)
-> Execution m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Execution m a
m ((ExecutionEnv m -> ExecutionEnv m) -> Execution m a)
-> (Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Jumper m a
-> Execution m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Jumper m a -> ExecutionEnv m -> ExecutionEnv m
f
doJump :: MonadBackend m =>
(ExecutionEnv m -> Jumper m a) -> a -> Execution m ()
doJump :: (ExecutionEnv m -> Jumper m a) -> Jumper m a
doJump ExecutionEnv m -> Jumper m a
b a
x = Execution m (Execution m ()) -> Execution m ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Execution m (Execution m ()) -> Execution m ())
-> Execution m (Execution m ()) -> Execution m ()
forall a b. (a -> b) -> a -> b
$ (ExecutionEnv m -> Jumper m a) -> Execution m (Jumper m a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ExecutionEnv m -> Jumper m a
b Execution m (Jumper m a)
-> Execution m a -> Execution m (Execution m ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Execution m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
returnHere :: MonadBackend m => Execution m Value -> Execution m Value
returnHere :: Execution m Value -> Execution m Value
returnHere = (Jumper m Value -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m Value -> Execution m Value
forall (m :: * -> *) a.
MonadBackend m =>
(Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump (\Jumper m Value
breaker ExecutionEnv m
env -> ExecutionEnv m
env { execReturn :: Jumper m Value
execReturn = Jumper m Value
breaker })
doReturn :: MonadBackend m => Value -> Execution m ()
doReturn :: Value -> Execution m ()
doReturn = (ExecutionEnv m -> Value -> Execution m ())
-> Value -> Execution m ()
forall (m :: * -> *) a.
MonadBackend m =>
(ExecutionEnv m -> Jumper m a) -> Jumper m a
doJump ExecutionEnv m -> Value -> Execution m ()
forall (m :: * -> *). ExecutionEnv m -> Jumper m Value
execReturn
nextHere :: MonadBackend m => Execution m () -> Execution m ()
nextHere :: Execution m () -> Execution m ()
nextHere = (Jumper m () -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m () -> Execution m ()
forall (m :: * -> *) a.
MonadBackend m =>
(Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump (\Jumper m ()
breaker ExecutionEnv m
env -> ExecutionEnv m
env { execNext :: Jumper m ()
execNext = Jumper m ()
breaker })
doNext :: MonadBackend m => Execution m ()
doNext :: Execution m ()
doNext = (ExecutionEnv m -> Jumper m ()) -> Jumper m ()
forall (m :: * -> *) a.
MonadBackend m =>
(ExecutionEnv m -> Jumper m a) -> Jumper m a
doJump ExecutionEnv m -> Jumper m ()
forall (m :: * -> *). ExecutionEnv m -> Jumper m ()
execNext ()
breakHere :: MonadBackend m => Execution m () -> Execution m ()
breakHere :: Execution m () -> Execution m ()
breakHere = (Jumper m () -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m () -> Execution m ()
forall (m :: * -> *) a.
MonadBackend m =>
(Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump (\Jumper m ()
breaker ExecutionEnv m
env -> ExecutionEnv m
env { execBreak :: Jumper m ()
execBreak = Jumper m ()
breaker })
doBreak :: MonadBackend m => Execution m ()
doBreak :: Execution m ()
doBreak = (ExecutionEnv m -> Jumper m ()) -> Jumper m ()
forall (m :: * -> *) a.
MonadBackend m =>
(ExecutionEnv m -> Jumper m a) -> Jumper m a
doJump ExecutionEnv m -> Jumper m ()
forall (m :: * -> *). ExecutionEnv m -> Jumper m ()
execBreak ()
contHere :: MonadBackend m => Execution m () -> Execution m ()
contHere :: Execution m () -> Execution m ()
contHere = (Jumper m () -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m () -> Execution m ()
forall (m :: * -> *) a.
MonadBackend m =>
(Jumper m a -> ExecutionEnv m -> ExecutionEnv m)
-> Execution m a -> Execution m a
setJump (\Jumper m ()
breaker ExecutionEnv m
env -> ExecutionEnv m
env { execCont :: Jumper m ()
execCont = Jumper m ()
breaker })
doCont :: MonadBackend m => Execution m ()
doCont :: Execution m ()
doCont = (ExecutionEnv m -> Jumper m ()) -> Jumper m ()
forall (m :: * -> *) a.
MonadBackend m =>
(ExecutionEnv m -> Jumper m a) -> Jumper m a
doJump ExecutionEnv m -> Jumper m ()
forall (m :: * -> *). ExecutionEnv m -> Jumper m ()
execCont ()
newtype Execution m a = Execution (ReaderT (ExecutionEnv m) (Sindre m) a)
deriving (a -> Execution m b -> Execution m a
(a -> b) -> Execution m a -> Execution m b
(forall a b. (a -> b) -> Execution m a -> Execution m b)
-> (forall a b. a -> Execution m b -> Execution m a)
-> Functor (Execution m)
forall a b. a -> Execution m b -> Execution m a
forall a b. (a -> b) -> Execution m a -> Execution 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 -> Execution m b -> Execution m a
forall (m :: * -> *) a b.
(a -> b) -> Execution m a -> Execution m b
<$ :: a -> Execution m b -> Execution m a
$c<$ :: forall (m :: * -> *) a b. a -> Execution m b -> Execution m a
fmap :: (a -> b) -> Execution m a -> Execution m b
$cfmap :: forall (m :: * -> *) a b.
(a -> b) -> Execution m a -> Execution m b
Functor, Applicative (Execution m)
a -> Execution m a
Applicative (Execution m)
-> (forall a b.
Execution m a -> (a -> Execution m b) -> Execution m b)
-> (forall a b. Execution m a -> Execution m b -> Execution m b)
-> (forall a. a -> Execution m a)
-> Monad (Execution m)
Execution m a -> (a -> Execution m b) -> Execution m b
Execution m a -> Execution m b -> Execution m b
forall a. a -> Execution m a
forall a b. Execution m a -> Execution m b -> Execution m b
forall a b. Execution m a -> (a -> Execution m b) -> Execution m b
forall (m :: * -> *). Applicative (Execution 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 -> Execution m a
forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m b
forall (m :: * -> *) a b.
Execution m a -> (a -> Execution m b) -> Execution m b
return :: a -> Execution m a
$creturn :: forall (m :: * -> *) a. a -> Execution m a
>> :: Execution m a -> Execution m b -> Execution m b
$c>> :: forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m b
>>= :: Execution m a -> (a -> Execution m b) -> Execution m b
$c>>= :: forall (m :: * -> *) a b.
Execution m a -> (a -> Execution m b) -> Execution m b
$cp1Monad :: forall (m :: * -> *). Applicative (Execution m)
Monad, Monad (Execution m)
Monad (Execution m)
-> (forall a. Identifier -> Execution m a)
-> MonadFail (Execution m)
Identifier -> Execution m a
forall a. Identifier -> Execution m a
forall (m :: * -> *).
Monad m -> (forall a. Identifier -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (Execution m)
forall (m :: * -> *) a. MonadFail m => Identifier -> Execution m a
fail :: Identifier -> Execution m a
$cfail :: forall (m :: * -> *) a. MonadFail m => Identifier -> Execution m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (Execution m)
MonadFail, Functor (Execution m)
a -> Execution m a
Functor (Execution m)
-> (forall a. a -> Execution m a)
-> (forall a b.
Execution m (a -> b) -> Execution m a -> Execution m b)
-> (forall a b c.
(a -> b -> c) -> Execution m a -> Execution m b -> Execution m c)
-> (forall a b. Execution m a -> Execution m b -> Execution m b)
-> (forall a b. Execution m a -> Execution m b -> Execution m a)
-> Applicative (Execution m)
Execution m a -> Execution m b -> Execution m b
Execution m a -> Execution m b -> Execution m a
Execution m (a -> b) -> Execution m a -> Execution m b
(a -> b -> c) -> Execution m a -> Execution m b -> Execution m c
forall a. a -> Execution m a
forall a b. Execution m a -> Execution m b -> Execution m a
forall a b. Execution m a -> Execution m b -> Execution m b
forall a b. Execution m (a -> b) -> Execution m a -> Execution m b
forall a b c.
(a -> b -> c) -> Execution m a -> Execution m b -> Execution m c
forall (m :: * -> *). Functor (Execution 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 -> Execution m a
forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m a
forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m b
forall (m :: * -> *) a b.
Execution m (a -> b) -> Execution m a -> Execution m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> Execution m a -> Execution m b -> Execution m c
<* :: Execution m a -> Execution m b -> Execution m a
$c<* :: forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m a
*> :: Execution m a -> Execution m b -> Execution m b
$c*> :: forall (m :: * -> *) a b.
Execution m a -> Execution m b -> Execution m b
liftA2 :: (a -> b -> c) -> Execution m a -> Execution m b -> Execution m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> Execution m a -> Execution m b -> Execution m c
<*> :: Execution m (a -> b) -> Execution m a -> Execution m b
$c<*> :: forall (m :: * -> *) a b.
Execution m (a -> b) -> Execution m a -> Execution m b
pure :: a -> Execution m a
$cpure :: forall (m :: * -> *) a. a -> Execution m a
$cp1Applicative :: forall (m :: * -> *). Functor (Execution m)
Applicative, MonadReader (ExecutionEnv m), Monad (Execution m)
Monad (Execution m)
-> (forall a b.
((a -> Execution m b) -> Execution m a) -> Execution m a)
-> MonadCont (Execution m)
((a -> Execution m b) -> Execution m a) -> Execution m a
forall a b.
((a -> Execution m b) -> Execution m a) -> Execution m a
forall (m :: * -> *). Monad (Execution m)
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall (m :: * -> *) a b.
((a -> Execution m b) -> Execution m a) -> Execution m a
callCC :: ((a -> Execution m b) -> Execution m a) -> Execution m a
$ccallCC :: forall (m :: * -> *) a b.
((a -> Execution m b) -> Execution m a) -> Execution m a
$cp1MonadCont :: forall (m :: * -> *). Monad (Execution m)
MonadCont)
execute :: MonadBackend m => Execution m Value -> Sindre m Value
execute :: Execution m Value -> Sindre m Value
execute Execution m Value
m = ReaderT (ExecutionEnv m) (Sindre m) Value
-> ExecutionEnv m -> Sindre m Value
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (ExecutionEnv m) (Sindre m) Value
m' ExecutionEnv m
env
where env :: ExecutionEnv m
env = ExecutionEnv :: forall (m :: * -> *).
Jumper m Value
-> Jumper m () -> Jumper m () -> Jumper m () -> ExecutionEnv m
ExecutionEnv {
execReturn :: Jumper m Value
execReturn = Execution m () -> Jumper m Value
forall a b. a -> b -> a
const (Execution m () -> Jumper m Value)
-> Execution m () -> Jumper m Value
forall a b. (a -> b) -> a -> b
$ Identifier -> Execution m ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Nowhere to return to"
, execNext :: Jumper m ()
execNext = Execution m () -> Jumper m ()
forall a b. a -> b -> a
const (Execution m () -> Jumper m ()) -> Execution m () -> Jumper m ()
forall a b. (a -> b) -> a -> b
$ Identifier -> Execution m ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Nowhere to go next"
, execBreak :: Jumper m ()
execBreak = Execution m () -> Jumper m ()
forall a b. a -> b -> a
const (Execution m () -> Jumper m ()) -> Execution m () -> Jumper m ()
forall a b. (a -> b) -> a -> b
$ Identifier -> Execution m ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Not in a loop"
, execCont :: Jumper m ()
execCont = Execution m () -> Jumper m ()
forall a b. a -> b -> a
const (Execution m () -> Jumper m ()) -> Execution m () -> Jumper m ()
forall a b. (a -> b) -> a -> b
$ Identifier -> Execution m ()
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Not in a loop"
}
Execution ReaderT (ExecutionEnv m) (Sindre m) Value
m' = Execution m Value -> Execution m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Execution m Value
returnHere Execution m Value
m
execute_ :: MonadBackend m => Execution m a -> Sindre m ()
execute_ :: Execution m a -> Sindre m ()
execute_ Execution m a
m = Sindre m Value -> Sindre m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sindre m Value -> Sindre m ()) -> Sindre m Value -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute (Execution m a
m Execution m a -> Execution m Value -> Execution m Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Value
Number Double
0))
instance MonadBackend im => MonadSindre im Execution where
sindre :: Sindre im a -> Execution im a
sindre = ReaderT (ExecutionEnv im) (Sindre im) a -> Execution im a
forall (m :: * -> *) a.
ReaderT (ExecutionEnv m) (Sindre m) a -> Execution m a
Execution (ReaderT (ExecutionEnv im) (Sindre im) a -> Execution im a)
-> (Sindre im a -> ReaderT (ExecutionEnv im) (Sindre im) a)
-> Sindre im a
-> Execution im a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sindre im a -> ReaderT (ExecutionEnv im) (Sindre im) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
setScope :: MonadBackend m => [Value] -> Execution m a -> Execution m a
setScope :: [Value] -> Execution m a -> Execution m a
setScope [Value]
vs Execution m a
ex =
Sindre m () -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre ((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 { execFrame :: IntMap Value
execFrame = IntMap Value
m }) Execution m () -> Execution m a -> Execution m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Execution m a
ex
where m :: IntMap Value
m = [(ObjectNum, Value)] -> IntMap Value
forall a. [(ObjectNum, a)] -> IntMap a
IM.fromList ([(ObjectNum, Value)] -> IntMap Value)
-> [(ObjectNum, Value)] -> IntMap Value
forall a b. (a -> b) -> a -> b
$ [ObjectNum] -> [Value] -> [(ObjectNum, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ObjectNum
0..] [Value]
vs
enterScope :: MonadBackend m => [Value] -> Execution m a -> Execution m a
enterScope :: [Value] -> Execution m a -> Execution m a
enterScope [Value]
vs Execution m a
se = do
IntMap Value
oldframe <- Sindre m (IntMap Value) -> Execution m (IntMap Value)
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m (IntMap Value) -> Execution m (IntMap Value))
-> Sindre m (IntMap Value) -> Execution m (IntMap Value)
forall a b. (a -> b) -> a -> b
$ (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
[Value] -> Execution m a -> Execution m a
forall (m :: * -> *) a.
MonadBackend m =>
[Value] -> Execution m a -> Execution m a
setScope [Value]
vs Execution m a
se Execution m a -> Execution m () -> Execution m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Sindre m () -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre ((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 { execFrame :: IntMap Value
execFrame = IntMap Value
oldframe })
lexicalVal :: MonadBackend m => IM.Key -> Execution m Value
lexicalVal :: ObjectNum -> Execution m Value
lexicalVal ObjectNum
k = Value -> ObjectNum -> IntMap Value -> Value
forall a. a -> ObjectNum -> IntMap a -> a
IM.findWithDefault Value
falsity ObjectNum
k (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)
setLexical :: MonadBackend m => IM.Key -> Value -> Execution m ()
setLexical :: ObjectNum -> Value -> Execution m ()
setLexical ObjectNum
k Value
v = Sindre m () -> Execution m ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre m () -> Execution m ()) -> Sindre m () -> Execution m ()
forall a b. (a -> b) -> a -> b
$ (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 { execFrame :: IntMap Value
execFrame = ObjectNum -> Value -> IntMap Value -> IntMap Value
forall a. ObjectNum -> a -> IntMap a -> IntMap a
IM.insert ObjectNum
k Value
v (IntMap Value -> IntMap Value) -> IntMap Value -> IntMap Value
forall a b. (a -> b) -> a -> b
$ SindreEnv m -> IntMap Value
forall (m :: * -> *). SindreEnv m -> IntMap Value
execFrame SindreEnv m
s }
operateW :: MonadBackend im => WidgetRef ->
(forall s . Widget s im -> Sindre im (a, Widget s im))
-> Sindre im a
operateW :: ObjectRef
-> (forall s. Widget s im -> Sindre im (a, Widget s im))
-> Sindre im a
operateW (ObjectNum
r,Identifier
_,Maybe Identifier
_) forall s. Widget s im -> Sindre im (a, Widget s im)
f = do
Array ObjectNum (DataSlot im)
objs <- (SindreEnv im -> Array ObjectNum (DataSlot im))
-> Sindre im (Array ObjectNum (DataSlot im))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv im -> Array ObjectNum (DataSlot im)
forall (m :: * -> *). SindreEnv m -> Array ObjectNum (DataSlot m)
objects
(a
v, DataSlot im
s') <- case Array ObjectNum (DataSlot im)
objsArray ObjectNum (DataSlot im) -> ObjectNum -> DataSlot im
forall i e. Ix i => Array i e -> i -> e
!ObjectNum
r of
WidgetSlot Widget s im
s -> do (a
v, Widget s im
s') <- Widget s im -> Sindre im (a, Widget s im)
forall s. Widget s im -> Sindre im (a, Widget s im)
f Widget s im
s
(a, DataSlot im) -> Sindre im (a, DataSlot im)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, Widget s im -> DataSlot im
forall (im :: * -> *) s. Widget s im -> DataSlot im
WidgetSlot Widget s im
s')
DataSlot im
_ -> Identifier -> Sindre im (a, DataSlot im)
forall (m :: * -> *) a. MonadFail m => Identifier -> m a
fail Identifier
"Expected widget"
(SindreEnv im -> SindreEnv im) -> Sindre im ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv im -> SindreEnv im) -> Sindre im ())
-> (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv im
s -> SindreEnv im
s { objects :: Array ObjectNum (DataSlot im)
objects = SindreEnv im -> Array ObjectNum (DataSlot im)
forall (m :: * -> *). SindreEnv m -> Array ObjectNum (DataSlot m)
objects SindreEnv im
s Array ObjectNum (DataSlot im)
-> [(ObjectNum, DataSlot im)] -> Array ObjectNum (DataSlot im)
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [(ObjectNum
r, DataSlot im
s')] }
a -> Sindre im a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
operateO :: MonadBackend im => ObjectRef ->
(forall s . Object s im -> Sindre im (a, Object s im)) -> Sindre im a
operateO :: ObjectRef
-> (forall s. Object s im -> Sindre im (a, Object s im))
-> Sindre im a
operateO (ObjectNum
r,Identifier
_,Maybe Identifier
_) forall s. Object s im -> Sindre im (a, Object s im)
f = do
Array ObjectNum (DataSlot im)
objs <- (SindreEnv im -> Array ObjectNum (DataSlot im))
-> Sindre im (Array ObjectNum (DataSlot im))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv im -> Array ObjectNum (DataSlot im)
forall (m :: * -> *). SindreEnv m -> Array ObjectNum (DataSlot m)
objects
(a
v, DataSlot im
s') <- case Array ObjectNum (DataSlot im)
objsArray ObjectNum (DataSlot im) -> ObjectNum -> DataSlot im
forall i e. Ix i => Array i e -> i -> e
!ObjectNum
r of
WidgetSlot Widget s im
s -> do (a
v, Object s im
s') <- Object s im -> Sindre im (a, Object s im)
forall s. Object s im -> Sindre im (a, Object s im)
f (Object s im -> Sindre im (a, Object s im))
-> Object s im -> Sindre im (a, Object s im)
forall a b. (a -> b) -> a -> b
$ Widget s im -> Object s im
forall s (im :: * -> *). Widget s im -> Object s im
widgetObject Widget s im
s
(a, DataSlot im) -> Sindre im (a, DataSlot im)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, Widget s im -> DataSlot im
forall (im :: * -> *) s. Widget s im -> DataSlot im
WidgetSlot Widget s im
s { widgetObject :: Object s im
widgetObject = Object s im
s' })
ObjectSlot Object s im
s -> do (a
v, Object s im
s') <- Object s im -> Sindre im (a, Object s im)
forall s. Object s im -> Sindre im (a, Object s im)
f Object s im
s
(a, DataSlot im) -> Sindre im (a, DataSlot im)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, Object s im -> DataSlot im
forall (im :: * -> *) s. Object s im -> DataSlot im
ObjectSlot Object s im
s')
(SindreEnv im -> SindreEnv im) -> Sindre im ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((SindreEnv im -> SindreEnv im) -> Sindre im ())
-> (SindreEnv im -> SindreEnv im) -> Sindre im ()
forall a b. (a -> b) -> a -> b
$ \SindreEnv im
s -> SindreEnv im
s { objects :: Array ObjectNum (DataSlot im)
objects = SindreEnv im -> Array ObjectNum (DataSlot im)
forall (m :: * -> *). SindreEnv m -> Array ObjectNum (DataSlot m)
objects SindreEnv im
s Array ObjectNum (DataSlot im)
-> [(ObjectNum, DataSlot im)] -> Array ObjectNum (DataSlot im)
forall i e. Ix i => Array i e -> [(i, e)] -> Array i e
// [(ObjectNum
r, DataSlot im
s')] }
a -> Sindre im a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
onState :: (Object s im -> Sindre im (a, s)) -> Object s im -> Sindre im (a, Object s im)
onState :: (Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState Object s im -> Sindre im (a, s)
f Object s im
s = do (a
v, s
s') <- Object s im -> Sindre im (a, s)
f Object s im
s
(a, Object s im) -> Sindre im (a, Object s im)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, Object s im
s { objectState :: s
objectState = s
s' })
onStateW :: (Widget s im -> Sindre im (a, s)) -> Widget s im -> Sindre im (a, Widget s im)
onStateW :: (Widget s im -> Sindre im (a, s))
-> Widget s im -> Sindre im (a, Widget s im)
onStateW Widget s im -> Sindre im (a, s)
f Widget s im
s = do (a
v, s
os) <- Widget s im -> Sindre im (a, s)
f Widget s im
s
(a, Widget s im) -> Sindre im (a, Widget s im)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
v, Widget s im
s { widgetObject :: Object s im
widgetObject = (Widget s im -> Object s im
forall s (im :: * -> *). Widget s im -> Object s im
widgetObject Widget s im
s)
{ objectState :: s
objectState = s
os }})
callMethodByRef :: MonadBackend im => ObjectRef -> Identifier -> [Value] -> Execution im Value
callMethodByRef :: ObjectRef -> Identifier -> [Value] -> Execution im Value
callMethodByRef ObjectRef
k Identifier
m [Value]
vs = Sindre im Value -> Execution im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im Value -> Execution im Value)
-> Sindre im Value -> Execution im Value
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Object s im -> Sindre im (a, Object s im))
-> Sindre im a
operateO ObjectRef
k ((forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value)
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall a b. (a -> b) -> a -> b
$ (Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im)
forall s (im :: * -> *) a.
(Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState ((Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im))
-> (Object s im -> Sindre im (Value, s))
-> Object s im
-> Sindre im (Value, Object s im)
forall a b. (a -> b) -> a -> b
$ Identifier
-> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s)
forall (im :: * -> *) s.
MonadFail im =>
Identifier
-> [Value] -> ObjectRef -> Object s im -> Sindre im (Value, s)
callMethodI Identifier
m [Value]
vs ObjectRef
k
setFieldByRef :: MonadBackend im => ObjectRef -> Identifier -> Value -> Execution im Value
setFieldByRef :: ObjectRef -> Identifier -> Value -> Execution im Value
setFieldByRef ObjectRef
k Identifier
f Value
v = Sindre im Value -> Execution im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im Value -> Execution im Value)
-> Sindre im Value -> Execution im Value
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Object s im -> Sindre im (a, Object s im))
-> Sindre im a
operateO ObjectRef
k ((forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value)
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall a b. (a -> b) -> a -> b
$ \Object s im
s -> do
(Value
old, Object s im
s') <- (Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im)
forall s (im :: * -> *) a.
(Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState (Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
forall (im :: * -> *) s.
MonadFail im =>
Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
getFieldI Identifier
f ObjectRef
k) Object s im
s
(Value
new, Object s im
s'') <- (Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im)
forall s (im :: * -> *) a.
(Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState (Identifier
-> Value -> ObjectRef -> Object s im -> Sindre im (Value, s)
forall (im :: * -> *) s.
MonadFail im =>
Identifier
-> Value -> ObjectRef -> Object s im -> Sindre im (Value, s)
setFieldI Identifier
f Value
v ObjectRef
k) Object s im
s'
((), s
os) <- ObjectM s im () -> ObjectRef -> s -> Sindre im ((), s)
forall s (im :: * -> *) a.
ObjectM s im a -> ObjectRef -> s -> Sindre im (a, s)
runObjectM (Identifier -> Value -> Value -> ObjectM s im ()
forall (im :: * -> *) o.
MonadBackend im =>
Identifier -> Value -> Value -> ObjectM o im ()
changed Identifier
f Value
old Value
new) ObjectRef
k (s -> Sindre im ((), s)) -> s -> Sindre im ((), s)
forall a b. (a -> b) -> a -> b
$ Object s im -> s
forall s (im :: * -> *). Object s im -> s
objectState Object s im
s''
(Value, Object s im) -> Sindre im (Value, Object s im)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value
new, Object s im
s'' { objectState :: s
objectState = s
os })
getFieldByRef :: MonadBackend im => ObjectRef -> Identifier -> Execution im Value
getFieldByRef :: ObjectRef -> Identifier -> Execution im Value
getFieldByRef ObjectRef
k Identifier
f = Sindre im Value -> Execution im Value
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im Value -> Execution im Value)
-> Sindre im Value -> Execution im Value
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Object s im -> Sindre im (a, Object s im))
-> Sindre im a
operateO ObjectRef
k ((forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value)
-> (forall s. Object s im -> Sindre im (Value, Object s im))
-> Sindre im Value
forall a b. (a -> b) -> a -> b
$ (Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im)
forall s (im :: * -> *) a.
(Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState ((Object s im -> Sindre im (Value, s))
-> Object s im -> Sindre im (Value, Object s im))
-> (Object s im -> Sindre im (Value, s))
-> Object s im
-> Sindre im (Value, Object s im)
forall a b. (a -> b) -> a -> b
$ Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
forall (im :: * -> *) s.
MonadFail im =>
Identifier -> ObjectRef -> Object s im -> Sindre im (Value, s)
getFieldI Identifier
f ObjectRef
k
recvEventByRef :: MonadBackend im => WidgetRef -> Event -> Execution im ()
recvEventByRef :: ObjectRef -> Event -> Execution im ()
recvEventByRef ObjectRef
k Event
ev = Sindre im () -> Execution im ()
forall (im :: * -> *) (m :: (* -> *) -> * -> *) a.
MonadSindre im m =>
Sindre im a -> m im a
sindre (Sindre im () -> Execution im ())
-> Sindre im () -> Execution im ()
forall a b. (a -> b) -> a -> b
$ ObjectRef
-> (forall s. Object s im -> Sindre im ((), Object s im))
-> Sindre im ()
forall (im :: * -> *) a.
MonadBackend im =>
ObjectRef
-> (forall s. Object s im -> Sindre im (a, Object s im))
-> Sindre im a
operateO ObjectRef
k ((forall s. Object s im -> Sindre im ((), Object s im))
-> Sindre im ())
-> (forall s. Object s im -> Sindre im ((), Object s im))
-> Sindre im ()
forall a b. (a -> b) -> a -> b
$ (Object s im -> Sindre im ((), s))
-> Object s im -> Sindre im ((), Object s im)
forall s (im :: * -> *) a.
(Object s im -> Sindre im (a, s))
-> Object s im -> Sindre im (a, Object s im)
onState ((Object s im -> Sindre im ((), s))
-> Object s im -> Sindre im ((), Object s im))
-> (Object s im -> Sindre im ((), s))
-> Object s im
-> Sindre im ((), Object s im)
forall a b. (a -> b) -> a -> b
$ Event -> ObjectRef -> Object s im -> Sindre im ((), s)
forall s (im :: * -> *).
Event -> ObjectRef -> Object s im -> Sindre im ((), s)
recvEventI Event
ev ObjectRef
k
type EventHandler m = Event -> Execution m ()
eventLoop :: MonadBackend m => EventHandler m -> Sindre m ()
eventLoop :: EventHandler m -> Sindre m ()
eventLoop EventHandler m
handler = do
let redraw_ :: Redraw -> Sindre m ()
redraw_ Redraw
RedrawAll = Sindre m ()
forall (m :: * -> *). MonadBackend m => Sindre m ()
redrawRoot
redraw_ (RedrawSome Set ObjectRef
s) = [SpaceUse] -> SpaceUse
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([SpaceUse] -> SpaceUse)
-> Sindre m [SpaceUse] -> Sindre m SpaceUse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectRef -> Sindre m SpaceUse)
-> [ObjectRef] -> Sindre m [SpaceUse]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ObjectRef -> Maybe Rectangle -> Sindre m SpaceUse
forall (im :: * -> *) (m :: (* -> *) -> * -> *).
MonadSindre im m =>
ObjectRef -> Maybe Rectangle -> m im SpaceUse
`draw` Maybe Rectangle
forall a. Maybe a
Nothing) (Set ObjectRef -> [ObjectRef]
forall a. Set a -> [a]
S.toList Set ObjectRef
s)
Sindre m SpaceUse -> (SpaceUse -> Sindre m ()) -> Sindre m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SpaceUse -> Sindre m ()
forall (m :: * -> *). MonadBackend m => SpaceUse -> Sindre m ()
redrawRegion
Sindre m Value -> Sindre m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Sindre m Value -> Sindre m ()) -> Sindre m Value -> Sindre m ()
forall a b. (a -> b) -> a -> b
$ do
Sindre m ()
process
Redraw -> Sindre m ()
forall (m :: * -> *). MonadBackend m => Redraw -> Sindre m ()
redraw_ (Redraw -> Sindre m ()) -> Sindre m Redraw -> Sindre m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SindreEnv m -> Redraw) -> Sindre m Redraw
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets SindreEnv m -> Redraw
forall (m :: * -> *). SindreEnv m -> Redraw
needsRedraw
(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 { needsRedraw :: Redraw
needsRedraw = Set ObjectRef -> Redraw
RedrawSome Set ObjectRef
forall a. Set a
S.empty }
Event -> Sindre m Value
handle (Event -> Sindre m Value) -> Sindre m Event -> Sindre m Value
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Sindre m Event
forall (m :: * -> *). MonadBackend m => Sindre m Event
waitForEvent
where handle :: Event -> Sindre m Value
handle Event
ev = Execution m Value -> Sindre m Value
forall (m :: * -> *).
MonadBackend m =>
Execution m Value -> Sindre m Value
execute (Execution m Value -> Sindre m Value)
-> Execution m Value -> Sindre m Value
forall a b. (a -> b) -> a -> b
$ Execution m () -> Execution m ()
forall (m :: * -> *).
MonadBackend m =>
Execution m () -> Execution m ()
nextHere (EventHandler m
handler Event
ev) Execution m () -> Execution m Value -> Execution m Value
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> Execution m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
falsity
process :: Sindre m ()
process = do Maybe Event
ev <- Sindre m (Maybe Event)
forall (m :: * -> *). MonadBackend m => Sindre m (Maybe Event)
getEvent
case Maybe Event
ev of
Just Event
ev' -> Event -> Sindre m Value
handle Event
ev' Sindre m Value -> Sindre m () -> Sindre m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sindre m ()
process
Maybe Event
Nothing -> () -> Sindre m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
class Mold a where
mold :: Value -> Maybe a
unmold :: a -> Value
instance Mold Value where
mold :: Value -> Maybe Value
mold = Value -> Maybe Value
forall a. a -> Maybe a
Just
unmold :: Value -> Value
unmold = Value -> Value
forall a. a -> a
id
instance Mold String where
mold :: Value -> Maybe Identifier
mold = Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier)
-> (Value -> Identifier) -> Value -> Maybe Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Identifier
forall a. Show a => a -> Identifier
show
unmold :: Identifier -> Value
unmold = Identifier -> Value
string
instance Mold T.Text where
mold :: Value -> Maybe Text
mold = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Value -> Text) -> Value -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
T.pack (Identifier -> Text) -> (Value -> Identifier) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Identifier
forall a. Show a => a -> Identifier
show
unmold :: Text -> Value
unmold = Text -> Value
StringV
instance Mold Double where
mold :: Value -> Maybe Double
mold (Reference (ObjectNum
v', Identifier
_, Maybe Identifier
_)) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ ObjectNum -> Double
forall a b. (Integral a, Num b) => a -> b
fi ObjectNum
v'
mold (Number Double
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x
mold Value
s = Identifier -> Maybe Double
parseInteger (Value -> Identifier
forall a. Show a => a -> Identifier
show Value
s)
unmold :: Double -> Value
unmold = Double -> Value
Number
instance Mold Integer where
mold :: Value -> Maybe Integer
mold (Reference (ObjectNum
v', Identifier
_, Maybe Identifier
_)) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ ObjectNum -> Integer
forall a b. (Integral a, Num b) => a -> b
fi ObjectNum
v'
mold (Number Double
x) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round Double
x
mold Value
s = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Maybe Double -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Maybe Double
parseInteger (Value -> Identifier
forall a. Show a => a -> Identifier
show Value
s)
unmold :: Integer -> Value
unmold = Double -> Value
Number (Double -> Value) -> (Integer -> Double) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger
instance Mold Int where
mold :: Value -> Maybe ObjectNum
mold = (Integer -> ObjectNum) -> Maybe Integer -> Maybe ObjectNum
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Integer -> ObjectNum
forall a b. (Integral a, Num b) => a -> b
fi :: Integer -> Int) (Maybe Integer -> Maybe ObjectNum)
-> (Value -> Maybe Integer) -> Value -> Maybe ObjectNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe Integer
forall a. Mold a => Value -> Maybe a
mold
unmold :: ObjectNum -> Value
unmold = Double -> Value
Number (Double -> Value) -> (ObjectNum -> Double) -> ObjectNum -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectNum -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
instance Mold Bool where
mold :: Value -> Maybe Bool
mold = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> (Value -> Bool) -> Value -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Bool
true
unmold :: Bool -> Value
unmold Bool
False = Value
falsity
unmold Bool
True = Value
truth
instance Mold () where
mold :: Value -> Maybe ()
mold Value
_ = () -> Maybe ()
forall a. a -> Maybe a
Just ()
unmold :: () -> Value
unmold ()
_ = Double -> Value
Number Double
0
instance Mold a => Mold (Maybe a) where
mold :: Value -> Maybe (Maybe a)
mold = (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a))
-> (Value -> Maybe a) -> Value -> Maybe (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe a
forall a. Mold a => Value -> Maybe a
mold
unmold :: Maybe a -> Value
unmold = Value -> (a -> Value) -> Maybe a -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
falsity a -> Value
forall a. Mold a => a -> Value
unmold
aligns :: [(String, (Align, Align))]
aligns :: [(Identifier, (Align, Align))]
aligns = [ (Identifier
"top", (Align
AlignCenter, Align
AlignNeg))
, (Identifier
"topleft", (Align
AlignNeg, Align
AlignNeg))
, (Identifier
"topright", (Align
AlignPos, Align
AlignNeg))
, (Identifier
"bot", (Align
AlignCenter, Align
AlignPos))
, (Identifier
"botleft", (Align
AlignNeg, Align
AlignPos))
, (Identifier
"botright", (Align
AlignPos, Align
AlignPos))
, (Identifier
"mid", (Align
AlignCenter, Align
AlignCenter))
, (Identifier
"midleft", (Align
AlignNeg, Align
AlignCenter))
, (Identifier
"midright", (Align
AlignPos, Align
AlignCenter))]
instance Mold (Align, Align) where
mold :: Value -> Maybe (Align, Align)
mold Value
s = Value -> Maybe Identifier
forall a. Mold a => Value -> Maybe a
mold Value
s Maybe Identifier
-> (Identifier -> Maybe (Align, Align)) -> Maybe (Align, Align)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Identifier
-> [(Identifier, (Align, Align))] -> Maybe (Align, Align))
-> [(Identifier, (Align, Align))]
-> Identifier
-> Maybe (Align, Align)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Identifier
-> [(Identifier, (Align, Align))] -> Maybe (Align, Align)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Identifier, (Align, Align))]
aligns
unmold :: (Align, Align) -> Value
unmold (Align, Align)
a = Value -> (Identifier -> Value) -> Maybe Identifier -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Double -> Value
Number Double
0) Identifier -> Value
string (Maybe Identifier -> Value) -> Maybe Identifier -> Value
forall a b. (a -> b) -> a -> b
$
(Align, Align)
-> [((Align, Align), Identifier)] -> Maybe Identifier
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Align, Align)
a (((Identifier, (Align, Align)) -> ((Align, Align), Identifier))
-> [(Identifier, (Align, Align))] -> [((Align, Align), Identifier)]
forall a b. (a -> b) -> [a] -> [b]
map ((Identifier -> (Align, Align) -> ((Align, Align), Identifier))
-> (Identifier, (Align, Align)) -> ((Align, Align), Identifier)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Identifier -> (Align, Align) -> ((Align, Align), Identifier))
-> (Identifier, (Align, Align)) -> ((Align, Align), Identifier))
-> (Identifier -> (Align, Align) -> ((Align, Align), Identifier))
-> (Identifier, (Align, Align))
-> ((Align, Align), Identifier)
forall a b. (a -> b) -> a -> b
$ ((Align, Align) -> Identifier -> ((Align, Align), Identifier))
-> Identifier -> (Align, Align) -> ((Align, Align), Identifier)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) [(Identifier, (Align, Align))]
aligns)