{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Sindre.Runtime
-- License     :  MIT-style (see LICENSE)
--
-- Stability   :  provisional
-- Portability :  portable
--
-- Definitions for the Sindre runtime environment.
--
-----------------------------------------------------------------------------
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

-- | A typed description of a field, which may be read-write or
-- read-only.  When constructing the actual widget, you must turn
-- these into real 'Field's by using the 'field' function.  A
-- description of a field consists of a name and monadic actions for
-- reading and optionally writing to the field.
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

-- | An opaque notion of a field.  These are for internal use in the
-- Sindre runtime.
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 ()
                        }

-- | Turn a Haskell-typed high-level field description into a
-- 'Value'-typed field.
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"

-- | A method takes as arguments a list of 'Value's and returns
-- another 'Value'.  You probably do not want to call these directly
-- from Haskell code, as they are dynamically typed.  See
-- 'Sindre.Lib.function' for a convenient way to turn a Haskell
-- function into a suitable method.
type Method s im = [Value] -> ObjectM s im Value

-- | Container describing a newly created widget.
data NewWidget im = forall s . NewWidget (Object s im)
                                (ObjectM s im SpaceNeed)
                                (Rectangle -> ObjectM s im SpaceUse)
-- | Container describing a newly created object.
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
            }

-- | A monad that can be used as the layer beneath 'Sindre'.
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 ()

-- | The main monad in which a Sindre program executes.  More
-- specialised monads, such as 'Execution' are used for specific
-- purposes, but they all run on top of the Sindre monad.
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 e m@ executes the action @m@ in environment @e@,
-- returning the exit code of @m@.
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

-- | Immediately return from 'execSindre', returning the given exit
-- code.
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

-- | @MonadSindre im m@ is the class of monads @m@ that run on top of
-- 'Sindre' with backend @im@, and can thus access Sindre
-- functionality.
class (MonadBackend im, MonadFail (m im), MonadFail im) => MonadSindre im m where
  -- | Lift a 'Sindre' operation into this monad.
  sindre :: Sindre im a -> m im a
  -- | Lift a backend operation into this monad.
  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)