{-# LANGUAGE CPP #-}
module Game.Goatee.Lib.Monad (
MonadGo (..),
GoT, GoM,
runGoT, runGo,
evalGoT, evalGo,
execGoT, execGo,
Step (..),
GoError (..),
NavigationError (..),
PopPositionError (..),
DropPositionError (..),
ModifyPropertyError (..),
ModifyGameInfoError (..),
NodeDeleteError (..),
goUpOrThrow,
goDownOrThrow,
goLeftOrThrow,
goRightOrThrow,
popPositionOrThrow,
dropPositionOrThrow,
modifyPropertyOrThrow,
modifyGameInfoOrThrow,
deleteChildAtOrThrow,
Event, AnyEvent (..), eventName, fire, eventHandlerFromAction,
childAddedEvent, ChildAddedHandler,
childDeletedEvent, ChildDeletedHandler,
gameInfoChangedEvent, GameInfoChangedHandler,
navigationEvent, NavigationHandler,
propertiesModifiedEvent, PropertiesModifiedHandler,
variationModeChangedEvent, VariationModeChangedHandler,
) where
#if !MIN_VERSION_containers(0,5,0)
import Control.Arrow (second)
#endif
import Control.Monad ((<=<), ap, forM, forM_, liftM, msum, unless, when)
import Control.Monad.Except (MonadError, catchError, throwError)
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail, fail)
#endif
import Control.Monad.Identity (Identity, runIdentity)
import qualified Control.Monad.State as State
import Control.Monad.State (MonadState, StateT, get, put)
import Control.Monad.Trans (MonadIO, MonadTrans, lift, liftIO)
import Control.Monad.Writer.Class (MonadWriter, listen, pass, tell, writer)
import qualified Data.Function as F
import Data.List (delete, find, mapAccumL, nub, sortBy)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (fromMaybe, isNothing)
import Data.Ord (comparing)
import Game.Goatee.Common
import Game.Goatee.Lib.Board
import Game.Goatee.Lib.Property
import qualified Game.Goatee.Lib.Tree as Tree
import Game.Goatee.Lib.Tree hiding (addChild, addChildAt, deleteChildAt)
import Game.Goatee.Lib.Types
#if !MIN_VERSION_base(4,13,0)
import Prelude hiding (fail)
#endif
data GoState go = GoState
{ GoState go -> Cursor
stateCursor :: Cursor
, GoState go -> PathStack
statePathStack :: PathStack
, GoState go -> [ChildAddedHandler go]
stateChildAddedHandlers :: [ChildAddedHandler go]
, GoState go -> [ChildDeletedHandler go]
stateChildDeletedHandlers :: [ChildDeletedHandler go]
, GoState go -> [GameInfoChangedHandler go]
stateGameInfoChangedHandlers :: [GameInfoChangedHandler go]
, GoState go -> [NavigationHandler go]
stateNavigationHandlers :: [NavigationHandler go]
, GoState go -> [PropertiesModifiedHandler go]
statePropertiesModifiedHandlers :: [PropertiesModifiedHandler go]
, GoState go -> [VariationModeChangedHandler go]
stateVariationModeChangedHandlers :: [VariationModeChangedHandler go]
}
type PathStack = [[Step]]
initialState :: Cursor -> GoState m
initialState :: Cursor -> GoState m
initialState Cursor
cursor = GoState :: forall (go :: * -> *).
Cursor
-> PathStack
-> [ChildAddedHandler go]
-> [ChildDeletedHandler go]
-> [GameInfoChangedHandler go]
-> [NavigationHandler go]
-> [PropertiesModifiedHandler go]
-> [VariationModeChangedHandler go]
-> GoState go
GoState { stateCursor :: Cursor
stateCursor = Cursor
cursor
, statePathStack :: PathStack
statePathStack = []
, stateChildAddedHandlers :: [ChildAddedHandler m]
stateChildAddedHandlers = []
, stateChildDeletedHandlers :: [ChildDeletedHandler m]
stateChildDeletedHandlers = []
, stateGameInfoChangedHandlers :: [GameInfoChangedHandler m]
stateGameInfoChangedHandlers = []
, stateNavigationHandlers :: [NavigationHandler m]
stateNavigationHandlers = []
, statePropertiesModifiedHandlers :: [PropertiesModifiedHandler m]
statePropertiesModifiedHandlers = []
, stateVariationModeChangedHandlers :: [VariationModeChangedHandler m]
stateVariationModeChangedHandlers = []
}
data Step =
GoUp Int
| GoDown Int
deriving (Step -> Step -> Bool
(Step -> Step -> Bool) -> (Step -> Step -> Bool) -> Eq Step
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step -> Step -> Bool
$c/= :: Step -> Step -> Bool
== :: Step -> Step -> Bool
$c== :: Step -> Step -> Bool
Eq, Int -> Step -> ShowS
[Step] -> ShowS
Step -> String
(Int -> Step -> ShowS)
-> (Step -> String) -> ([Step] -> ShowS) -> Show Step
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step] -> ShowS
$cshowList :: [Step] -> ShowS
show :: Step -> String
$cshow :: Step -> String
showsPrec :: Int -> Step -> ShowS
$cshowsPrec :: Int -> Step -> ShowS
Show)
reverseStep :: Step -> Step
reverseStep :: Step -> Step
reverseStep Step
step = case Step
step of
GoUp Int
index -> Int -> Step
GoDown Int
index
GoDown Int
index -> Int -> Step
GoUp Int
index
takeStep :: Step -> Cursor -> Cursor
takeStep :: Step -> Cursor -> Cursor
takeStep (GoUp Int
_) Cursor
cursor = Cursor -> Maybe Cursor -> Cursor
forall a. a -> Maybe a -> a
fromMaybe (String -> Cursor
forall a. HasCallStack => String -> a
error (String -> Cursor) -> String -> Cursor
forall a b. (a -> b) -> a -> b
$ String
"takeStep: Can't go up from " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Cursor -> String
forall a. Show a => a -> String
show Cursor
cursor String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".") (Maybe Cursor -> Cursor) -> Maybe Cursor -> Cursor
forall a b. (a -> b) -> a -> b
$
Cursor -> Maybe Cursor
cursorParent Cursor
cursor
takeStep (GoDown Int
index) Cursor
cursor = Cursor -> Int -> Cursor
cursorChild Cursor
cursor Int
index
takeStepM :: Monad m => Step -> (PathStack -> PathStack) -> GoT m Bool
takeStepM :: Step -> (PathStack -> PathStack) -> GoT m Bool
takeStepM Step
step = case Step
step of
GoUp Int
_ -> (PathStack -> PathStack) -> GoT m Bool
forall (m :: * -> *).
Monad m =>
(PathStack -> PathStack) -> GoT m Bool
goUp'
GoDown Int
index -> Int -> (PathStack -> PathStack) -> GoT m Bool
forall (m :: * -> *).
Monad m =>
Int -> (PathStack -> PathStack) -> GoT m Bool
goDown' Int
index
class (Functor go, Applicative go, Monad go) => MonadGo go where
getCursor :: go Cursor
getCoordState :: Coord -> go CoordState
getCoordState Coord
coord = (Cursor -> CoordState) -> go Cursor -> go CoordState
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Coord -> BoardState -> CoordState
boardCoordState Coord
coord (BoardState -> CoordState)
-> (Cursor -> BoardState) -> Cursor -> CoordState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> BoardState
cursorBoard) go Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
goUp :: go Bool
goDown :: Int -> go Bool
goLeft :: go Bool
goRight :: go Bool
goToRoot :: go ()
goToGameInfoNode :: Bool
-> go Bool
pushPosition :: go ()
popPosition :: go (Either PopPositionError ())
dropPosition :: go (Either DropPositionError ())
getProperties :: go [Property]
getProperties = (Cursor -> [Property]) -> go Cursor -> go [Property]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Cursor -> [Property]
cursorProperties go Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
modifyProperties :: ([Property] -> [Property]) -> go ()
getProperty :: Descriptor d => d -> go (Maybe Property)
getPropertyValue :: ValuedDescriptor v d => d -> go (Maybe v)
getPropertyValue d
descriptor = (Maybe Property -> Maybe v) -> go (Maybe Property) -> go (Maybe v)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Property -> v) -> Maybe Property -> Maybe v
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Property -> v) -> Maybe Property -> Maybe v)
-> (Property -> v) -> Maybe Property -> Maybe v
forall a b. (a -> b) -> a -> b
$ d -> Property -> v
forall v a. ValuedDescriptor v a => a -> Property -> v
propertyValue d
descriptor) (go (Maybe Property) -> go (Maybe v))
-> go (Maybe Property) -> go (Maybe v)
forall a b. (a -> b) -> a -> b
$ d -> go (Maybe Property)
forall (go :: * -> *) d.
(MonadGo go, Descriptor d) =>
d -> go (Maybe Property)
getProperty d
descriptor
putProperty :: Property -> go ()
putProperty Property
property = do
Either ModifyPropertyError ()
result <- Property
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
forall (go :: * -> *) d.
(MonadGo go, Descriptor d) =>
d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
modifyProperty Property
property ((Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ()))
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
forall a b. (a -> b) -> a -> b
$ Maybe Property -> Maybe Property -> Maybe Property
forall a b. a -> b -> a
const (Maybe Property -> Maybe Property -> Maybe Property)
-> Maybe Property -> Maybe Property -> Maybe Property
forall a b. (a -> b) -> a -> b
$ Property -> Maybe Property
forall a. a -> Maybe a
Just Property
property
case Either ModifyPropertyError ()
result of
Right () -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left (ModifyPropertyCannotChangeType String
old String
new) ->
String -> go ()
forall a. HasCallStack => String -> a
error (String -> go ()) -> String -> go ()
forall a b. (a -> b) -> a -> b
$ String
"MonadGo.putProperty: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Internal error, should not have attempted to change property type " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"(old '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', new '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')."
deleteProperty :: Descriptor d => d -> go ()
deleteProperty d
descriptor = do
Either ModifyPropertyError ()
result <- d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
forall (go :: * -> *) d.
(MonadGo go, Descriptor d) =>
d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
modifyProperty d
descriptor ((Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ()))
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
forall a b. (a -> b) -> a -> b
$ Maybe Property -> Maybe Property -> Maybe Property
forall a b. a -> b -> a
const Maybe Property
forall a. Maybe a
Nothing
case Either ModifyPropertyError ()
result of
Right () -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left (ModifyPropertyCannotChangeType String
old String
new) ->
String -> go ()
forall a. HasCallStack => String -> a
error (String -> go ()) -> String -> go ()
forall a b. (a -> b) -> a -> b
$ String
"MonadGo.deleteProperty: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Internal error, should not have attempted to change property type " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"(old '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', new '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')."
modifyProperty :: Descriptor d
=> d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
modifyPropertyValue :: ValuedDescriptor v d => d -> (Maybe v -> Maybe v) -> go ()
modifyPropertyValue d
descriptor Maybe v -> Maybe v
fn = d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
forall (go :: * -> *) d.
(MonadGo go, Descriptor d) =>
d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
modifyProperty d
descriptor Maybe Property -> Maybe Property
modify go (Either ModifyPropertyError ())
-> (Either ModifyPropertyError () -> go ()) -> go ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right () -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left (ModifyPropertyCannotChangeType String
old String
new) ->
String -> go ()
forall a. HasCallStack => String -> a
error (String -> go ()) -> String -> go ()
forall a b. (a -> b) -> a -> b
$ String
"MonadGo.modifyPropertyValue: Internal error, attempted to change " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"property type (old '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
old String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', new '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
new String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')."
where modify :: Maybe Property -> Maybe Property
modify Maybe Property
old =
d -> v -> Property
forall v a. ValuedDescriptor v a => a -> v -> Property
propertyBuilder d
descriptor (v -> Property) -> Maybe v -> Maybe Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe v -> Maybe v
fn (d -> Property -> v
forall v a. ValuedDescriptor v a => a -> Property -> v
propertyValue d
descriptor (Property -> v) -> Maybe Property -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Property
old)
modifyPropertyString :: (Stringlike s, ValuedDescriptor s d) => d -> (String -> String) -> go ()
modifyPropertyString d
descriptor ShowS
fn =
d -> (Maybe s -> Maybe s) -> go ()
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> (Maybe v -> Maybe v) -> go ()
modifyPropertyValue d
descriptor ((Maybe s -> Maybe s) -> go ()) -> (Maybe s -> Maybe s) -> go ()
forall a b. (a -> b) -> a -> b
$ \Maybe s
value -> case ShowS
fn (String -> (s -> String) -> Maybe s -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" s -> String
forall a. Stringlike a => a -> String
sgfToString Maybe s
value) of
String
"" -> Maybe s
forall a. Maybe a
Nothing
String
str -> let sgf :: s
sgf = String -> s
forall a. Stringlike a => String -> a
stringToSgf String
str
in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ s -> String
forall a. Stringlike a => a -> String
sgfToString s
sgf then Maybe s
forall a. Maybe a
Nothing else s -> Maybe s
forall a. a -> Maybe a
Just s
sgf
modifyPropertyList :: ValuedDescriptor [v] d => d -> ([v] -> [v]) -> go ()
modifyPropertyList d
descriptor [v] -> [v]
fn =
d -> (Maybe [v] -> Maybe [v]) -> go ()
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> (Maybe v -> Maybe v) -> go ()
modifyPropertyValue d
descriptor ((Maybe [v] -> Maybe [v]) -> go ())
-> (Maybe [v] -> Maybe [v]) -> go ()
forall a b. (a -> b) -> a -> b
$ \Maybe [v]
value -> case [v] -> [v]
fn ([v] -> [v]) -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ [v] -> Maybe [v] -> [v]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [v]
value of
[] -> Maybe [v]
forall a. Maybe a
Nothing
[v]
value' -> [v] -> Maybe [v]
forall a. a -> Maybe a
Just [v]
value'
modifyPropertyCoords :: ValuedDescriptor CoordList d => d -> ([Coord] -> [Coord]) -> go ()
modifyPropertyCoords d
descriptor [Coord] -> [Coord]
fn =
d -> (Maybe CoordList -> Maybe CoordList) -> go ()
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> (Maybe v -> Maybe v) -> go ()
modifyPropertyValue d
descriptor ((Maybe CoordList -> Maybe CoordList) -> go ())
-> (Maybe CoordList -> Maybe CoordList) -> go ()
forall a b. (a -> b) -> a -> b
$ \Maybe CoordList
value -> case [Coord] -> [Coord]
fn ([Coord] -> [Coord]) -> [Coord] -> [Coord]
forall a b. (a -> b) -> a -> b
$ [Coord] -> (CoordList -> [Coord]) -> Maybe CoordList -> [Coord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CoordList -> [Coord]
expandCoordList Maybe CoordList
value of
[] -> Maybe CoordList
forall a. Maybe a
Nothing
[Coord]
coords -> CoordList -> Maybe CoordList
forall a. a -> Maybe a
Just (CoordList -> Maybe CoordList) -> CoordList -> Maybe CoordList
forall a b. (a -> b) -> a -> b
$ [Coord] -> CoordList
buildCoordList [Coord]
coords
modifyGameInfo :: (GameInfo -> GameInfo)
-> go (Either ModifyGameInfoError (GameInfo, GameInfo))
modifyVariationMode :: (VariationMode -> VariationMode) -> go ()
getAssignedStone :: Coord -> go (Maybe (Maybe Color))
getAssignedStone Coord
coord =
([Maybe (Maybe Color)] -> Maybe (Maybe Color))
-> go [Maybe (Maybe Color)] -> go (Maybe (Maybe Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Maybe Color)] -> Maybe (Maybe Color)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (go [Maybe (Maybe Color)] -> go (Maybe (Maybe Color)))
-> go [Maybe (Maybe Color)] -> go (Maybe (Maybe Color))
forall a b. (a -> b) -> a -> b
$ [AnyCoordListDescriptor]
-> (AnyCoordListDescriptor -> go (Maybe (Maybe Color)))
-> go [Maybe (Maybe Color)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AnyCoordListDescriptor]
stoneAssignmentProperties ((AnyCoordListDescriptor -> go (Maybe (Maybe Color)))
-> go [Maybe (Maybe Color)])
-> (AnyCoordListDescriptor -> go (Maybe (Maybe Color)))
-> go [Maybe (Maybe Color)]
forall a b. (a -> b) -> a -> b
$ \AnyCoordListDescriptor
descriptor ->
((\[Coord]
coords -> if Coord
coord Coord -> [Coord] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Coord]
coords
then Maybe Color -> Maybe (Maybe Color)
forall a. a -> Maybe a
Just (Maybe Color -> Maybe (Maybe Color))
-> Maybe Color -> Maybe (Maybe Color)
forall a b. (a -> b) -> a -> b
$ AnyCoordListDescriptor -> Maybe Color
stoneAssignmentPropertyToStone AnyCoordListDescriptor
descriptor
else Maybe (Maybe Color)
forall a. Maybe a
Nothing) ([Coord] -> Maybe (Maybe Color))
-> (Maybe CoordList -> Maybe [Coord])
-> Maybe CoordList
-> Maybe (Maybe Color)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
(CoordList -> [Coord]) -> Maybe CoordList -> Maybe [Coord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CoordList -> [Coord]
expandCoordList) (Maybe CoordList -> Maybe (Maybe Color))
-> go (Maybe CoordList) -> go (Maybe (Maybe Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
AnyCoordListDescriptor -> go (Maybe CoordList)
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> go (Maybe v)
getPropertyValue AnyCoordListDescriptor
descriptor
getAllAssignedStones :: go (Map Coord (Maybe Color))
getAllAssignedStones =
([Map Coord (Maybe Color)] -> Map Coord (Maybe Color))
-> go [Map Coord (Maybe Color)] -> go (Map Coord (Maybe Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Map Coord (Maybe Color)] -> Map Coord (Maybe Color)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (go [Map Coord (Maybe Color)] -> go (Map Coord (Maybe Color)))
-> go [Map Coord (Maybe Color)] -> go (Map Coord (Maybe Color))
forall a b. (a -> b) -> a -> b
$ [AnyCoordListDescriptor]
-> (AnyCoordListDescriptor -> go (Map Coord (Maybe Color)))
-> go [Map Coord (Maybe Color)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [AnyCoordListDescriptor]
stoneAssignmentProperties ((AnyCoordListDescriptor -> go (Map Coord (Maybe Color)))
-> go [Map Coord (Maybe Color)])
-> (AnyCoordListDescriptor -> go (Map Coord (Maybe Color)))
-> go [Map Coord (Maybe Color)]
forall a b. (a -> b) -> a -> b
$ \AnyCoordListDescriptor
descriptor ->
let stone :: Maybe Color
stone = AnyCoordListDescriptor -> Maybe Color
stoneAssignmentPropertyToStone AnyCoordListDescriptor
descriptor
in [(Coord, Maybe Color)] -> Map Coord (Maybe Color)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Coord, Maybe Color)] -> Map Coord (Maybe Color))
-> (Maybe CoordList -> [(Coord, Maybe Color)])
-> Maybe CoordList
-> Map Coord (Maybe Color)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coord -> (Coord, Maybe Color))
-> [Coord] -> [(Coord, Maybe Color)]
forall a b. (a -> b) -> [a] -> [b]
map (\Coord
coord -> (Coord
coord, Maybe Color
stone)) ([Coord] -> [(Coord, Maybe Color)])
-> (Maybe CoordList -> [Coord])
-> Maybe CoordList
-> [(Coord, Maybe Color)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coord] -> (CoordList -> [Coord]) -> Maybe CoordList -> [Coord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] CoordList -> [Coord]
expandCoordList (Maybe CoordList -> Map Coord (Maybe Color))
-> go (Maybe CoordList) -> go (Map Coord (Maybe Color))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
AnyCoordListDescriptor -> go (Maybe CoordList)
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> go (Maybe v)
getPropertyValue AnyCoordListDescriptor
descriptor
modifyAssignedStones :: [Coord] -> (Maybe (Maybe Color) -> Maybe (Maybe Color)) -> go ()
modifyAssignedStones [Coord]
coords Maybe (Maybe Color) -> Maybe (Maybe Color)
f = do
Bool
needChild <- (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> ([PropertyType] -> Bool) -> [PropertyType] -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropertyType -> [PropertyType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem PropertyType
SetupProperty ([PropertyType] -> Bool -> Bool)
-> ([PropertyType] -> Bool) -> [PropertyType] -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PropertyType -> [PropertyType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem PropertyType
MoveProperty) ([PropertyType] -> Bool)
-> ([Property] -> [PropertyType]) -> [Property] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Property -> PropertyType) -> [Property] -> [PropertyType]
forall a b. (a -> b) -> [a] -> [b]
map Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType ([Property] -> Bool) -> go [Property] -> go Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
go [Property]
forall (go :: * -> *). MonadGo go => go [Property]
getProperties
if Bool
needChild
then case Maybe (Maybe Color) -> Maybe (Maybe Color)
f Maybe (Maybe Color)
forall a. Maybe a
Nothing of
Maybe (Maybe Color)
Nothing -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Maybe Color
assignedStone -> do
Node -> go ()
forall (go :: * -> *). MonadGo go => Node -> go ()
addChild Node
emptyNode { nodeProperties :: [Property]
nodeProperties =
[AnyCoordListDescriptor -> CoordList -> Property
forall v a. ValuedDescriptor v a => a -> v -> Property
propertyBuilder (Maybe Color -> AnyCoordListDescriptor
stoneToStoneAssignmentProperty Maybe Color
assignedStone) (CoordList -> Property) -> CoordList -> Property
forall a b. (a -> b) -> a -> b
$
[Coord] -> CoordList
buildCoordList [Coord]
coords]
}
Bool
ok <- Int -> go Bool
forall (go :: * -> *). MonadGo go => Int -> go Bool
goDown (Int -> go Bool) -> go Int -> go Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 (Int -> Int) -> (Cursor -> Int) -> Cursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Cursor] -> Int) -> (Cursor -> [Cursor]) -> Cursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [Cursor]
cursorChildren (Cursor -> Int) -> go Cursor -> go Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> go Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
Bool -> go () -> go ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (go () -> go ()) -> go () -> go ()
forall a b. (a -> b) -> a -> b
$ String -> go ()
forall a. HasCallStack => String -> a
error String
"GoT.modifyAssignedStones: Failed to move to new child."
else do
Map Coord (Maybe Color)
allAssignedStones <- go (Map Coord (Maybe Color))
forall (go :: * -> *). MonadGo go => go (Map Coord (Maybe Color))
getAllAssignedStones
let
allAssignedStones' :: Map Coord (Maybe Color)
allAssignedStones' = (Coord -> Map Coord (Maybe Color) -> Map Coord (Maybe Color))
-> Map Coord (Maybe Color) -> [Coord] -> Map Coord (Maybe Color)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Maybe (Maybe Color) -> Maybe (Maybe Color))
-> Coord -> Map Coord (Maybe Color) -> Map Coord (Maybe Color)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Maybe Color) -> Maybe (Maybe Color)
f) Map Coord (Maybe Color)
allAssignedStones [Coord]
coords
byStone, byStone' :: Map (Maybe Color) [Coord]
byStone :: Map (Maybe Color) [Coord]
byStone = Map Coord (Maybe Color) -> Map (Maybe Color) [Coord]
forall v k. Ord v => Map k v -> Map v [k]
mapInvert Map Coord (Maybe Color)
allAssignedStones
byStone' :: Map (Maybe Color) [Coord]
byStone' = Map Coord (Maybe Color) -> Map (Maybe Color) [Coord]
forall v k. Ord v => Map k v -> Map v [k]
mapInvert Map Coord (Maybe Color)
allAssignedStones'
diff :: Map (Maybe Color) ([Coord], [Coord])
#if MIN_VERSION_containers(0,5,0)
diff :: Map (Maybe Color) ([Coord], [Coord])
diff = (Maybe Color -> [Coord] -> [Coord] -> Maybe ([Coord], [Coord]))
-> (Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord]))
-> (Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord])
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
(\Maybe Color
_ [Coord]
oldCoords [Coord]
newCoords -> if [Coord]
newCoords [Coord] -> [Coord] -> Bool
forall a. Eq a => a -> a -> Bool
== [Coord]
oldCoords
then Maybe ([Coord], [Coord])
forall a. Maybe a
Nothing
else ([Coord], [Coord]) -> Maybe ([Coord], [Coord])
forall a. a -> Maybe a
Just ([Coord]
oldCoords, [Coord]
newCoords))
(([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord]))
-> ([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord])
forall a b. (a -> b) -> a -> b
$ \[Coord]
oldCoords -> ([Coord]
oldCoords, []))
(([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord])
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord]))
-> ([Coord] -> ([Coord], [Coord]))
-> Map (Maybe Color) [Coord]
-> Map (Maybe Color) ([Coord], [Coord])
forall a b. (a -> b) -> a -> b
$ \[Coord]
newCoords -> ([], [Coord]
newCoords))
Map (Maybe Color) [Coord]
byStone
Map (Maybe Color) [Coord]
byStone'
#else
diff = (\partialDiff ->
foldr (\(stone, new) ->
Map.alter (Just . maybe ([], new) (second $ const new))
stone)
partialDiff
(Map.assocs byStone')) $
Map.map (\old -> (old, [])) byStone
#endif
[(Maybe Color, ([Coord], [Coord]))]
-> ((Maybe Color, ([Coord], [Coord])) -> go ()) -> go ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map (Maybe Color) ([Coord], [Coord])
-> [(Maybe Color, ([Coord], [Coord]))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (Maybe Color) ([Coord], [Coord])
diff) (((Maybe Color, ([Coord], [Coord])) -> go ()) -> go ())
-> ((Maybe Color, ([Coord], [Coord])) -> go ()) -> go ()
forall a b. (a -> b) -> a -> b
$ \(Maybe Color
stone, ([Coord]
oldCoords, [Coord]
newCoords)) ->
Bool -> go () -> go ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Coord]
newCoords [Coord] -> [Coord] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Coord]
oldCoords) (go () -> go ()) -> go () -> go ()
forall a b. (a -> b) -> a -> b
$
AnyCoordListDescriptor -> ([Coord] -> [Coord]) -> go ()
forall (go :: * -> *) d.
(MonadGo go, ValuedDescriptor CoordList d) =>
d -> ([Coord] -> [Coord]) -> go ()
modifyPropertyCoords (Maybe Color -> AnyCoordListDescriptor
stoneToStoneAssignmentProperty Maybe Color
stone) (([Coord] -> [Coord]) -> go ()) -> ([Coord] -> [Coord]) -> go ()
forall a b. (a -> b) -> a -> b
$ [Coord] -> [Coord] -> [Coord]
forall a b. a -> b -> a
const [Coord]
newCoords
getMark :: Coord -> go (Maybe Mark)
getMark = (CoordState -> Maybe Mark) -> go CoordState -> go (Maybe Mark)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CoordState -> Maybe Mark
coordMark (go CoordState -> go (Maybe Mark))
-> (Coord -> go CoordState) -> Coord -> go (Maybe Mark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coord -> go CoordState
forall (go :: * -> *). MonadGo go => Coord -> go CoordState
getCoordState
modifyMark :: (Maybe Mark -> Maybe Mark) -> Coord -> go ()
modifyMark Maybe Mark -> Maybe Mark
f Coord
coord = do
Maybe Mark
maybeOldMark <- Coord -> go (Maybe Mark)
forall (go :: * -> *). MonadGo go => Coord -> go (Maybe Mark)
getMark Coord
coord
case (Maybe Mark
maybeOldMark, Maybe Mark -> Maybe Mark
f Maybe Mark
maybeOldMark) of
(Just Mark
oldMark, Maybe Mark
Nothing) -> Mark -> go ()
forall (go :: * -> *). MonadGo go => Mark -> go ()
remove Mark
oldMark
(Maybe Mark
Nothing, Just Mark
newMark) -> Mark -> go ()
forall (go :: * -> *). MonadGo go => Mark -> go ()
add Mark
newMark
(Just Mark
oldMark, Just Mark
newMark) | Mark
oldMark Mark -> Mark -> Bool
forall a. Eq a => a -> a -> Bool
/= Mark
newMark -> Mark -> go ()
forall (go :: * -> *). MonadGo go => Mark -> go ()
remove Mark
oldMark go () -> go () -> go ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Mark -> go ()
forall (go :: * -> *). MonadGo go => Mark -> go ()
add Mark
newMark
(Just Mark
_, Just Mark
_) -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Maybe Mark
Nothing, Maybe Mark
Nothing) -> () -> go ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where remove :: Mark -> go ()
remove Mark
mark = ValuedPropertyInfo CoordList -> ([Coord] -> [Coord]) -> go ()
forall (go :: * -> *) d.
(MonadGo go, ValuedDescriptor CoordList d) =>
d -> ([Coord] -> [Coord]) -> go ()
modifyPropertyCoords (Mark -> ValuedPropertyInfo CoordList
markProperty Mark
mark) (Coord -> [Coord] -> [Coord]
forall a. Eq a => a -> [a] -> [a]
delete Coord
coord)
add :: Mark -> go ()
add Mark
mark = ValuedPropertyInfo CoordList -> ([Coord] -> [Coord]) -> go ()
forall (go :: * -> *) d.
(MonadGo go, ValuedDescriptor CoordList d) =>
d -> ([Coord] -> [Coord]) -> go ()
modifyPropertyCoords (Mark -> ValuedPropertyInfo CoordList
markProperty Mark
mark) (Coord
coordCoord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
:)
addChild :: Node -> go ()
addChild Node
node = do
Int
childCount <- (Cursor -> Int) -> go Cursor -> go Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Cursor] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Cursor] -> Int) -> (Cursor -> [Cursor]) -> Cursor -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> [Cursor]
cursorChildren) go Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
Int -> Node -> go ()
forall (go :: * -> *). MonadGo go => Int -> Node -> go ()
addChildAt Int
childCount Node
node
addChildAt :: Int -> Node -> go ()
deleteChildAt :: Int -> go (Either NodeDeleteError ())
on :: Event go h -> h -> go ()
on0 :: Event go h -> go () -> go ()
on0 Event go h
event go ()
handler = Event go h -> h -> go ()
forall (go :: * -> *) h. MonadGo go => Event go h -> h -> go ()
on Event go h
event (h -> go ()) -> h -> go ()
forall a b. (a -> b) -> a -> b
$ Event go h -> go () -> h
forall (go :: * -> *) h. Event go h -> go () -> h
eventHandlerFromAction Event go h
event go ()
handler
data GoError =
GoNavigationError NavigationError
| GoPopPositionError PopPositionError
| GoDropPositionError DropPositionError
| GoModifyPropertyError ModifyPropertyError
| GoModifyGameInfoError ModifyGameInfoError
| GoNodeDeleteError NodeDeleteError
deriving (GoError -> GoError -> Bool
(GoError -> GoError -> Bool)
-> (GoError -> GoError -> Bool) -> Eq GoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoError -> GoError -> Bool
$c/= :: GoError -> GoError -> Bool
== :: GoError -> GoError -> Bool
$c== :: GoError -> GoError -> Bool
Eq, Int -> GoError -> ShowS
[GoError] -> ShowS
GoError -> String
(Int -> GoError -> ShowS)
-> (GoError -> String) -> ([GoError] -> ShowS) -> Show GoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoError] -> ShowS
$cshowList :: [GoError] -> ShowS
show :: GoError -> String
$cshow :: GoError -> String
showsPrec :: Int -> GoError -> ShowS
$cshowsPrec :: Int -> GoError -> ShowS
Show)
data NavigationError =
NavigationCouldNotMove
deriving (NavigationError -> NavigationError -> Bool
(NavigationError -> NavigationError -> Bool)
-> (NavigationError -> NavigationError -> Bool)
-> Eq NavigationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NavigationError -> NavigationError -> Bool
$c/= :: NavigationError -> NavigationError -> Bool
== :: NavigationError -> NavigationError -> Bool
$c== :: NavigationError -> NavigationError -> Bool
Eq, Int -> NavigationError -> ShowS
[NavigationError] -> ShowS
NavigationError -> String
(Int -> NavigationError -> ShowS)
-> (NavigationError -> String)
-> ([NavigationError] -> ShowS)
-> Show NavigationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NavigationError] -> ShowS
$cshowList :: [NavigationError] -> ShowS
show :: NavigationError -> String
$cshow :: NavigationError -> String
showsPrec :: Int -> NavigationError -> ShowS
$cshowsPrec :: Int -> NavigationError -> ShowS
Show)
data PopPositionError =
PopPositionStackEmpty
| PopPositionCannotRetraceSteps
deriving (PopPositionError -> PopPositionError -> Bool
(PopPositionError -> PopPositionError -> Bool)
-> (PopPositionError -> PopPositionError -> Bool)
-> Eq PopPositionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PopPositionError -> PopPositionError -> Bool
$c/= :: PopPositionError -> PopPositionError -> Bool
== :: PopPositionError -> PopPositionError -> Bool
$c== :: PopPositionError -> PopPositionError -> Bool
Eq, Int -> PopPositionError -> ShowS
[PopPositionError] -> ShowS
PopPositionError -> String
(Int -> PopPositionError -> ShowS)
-> (PopPositionError -> String)
-> ([PopPositionError] -> ShowS)
-> Show PopPositionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PopPositionError] -> ShowS
$cshowList :: [PopPositionError] -> ShowS
show :: PopPositionError -> String
$cshow :: PopPositionError -> String
showsPrec :: Int -> PopPositionError -> ShowS
$cshowsPrec :: Int -> PopPositionError -> ShowS
Show)
data DropPositionError =
DropPositionStackEmpty
deriving (DropPositionError -> DropPositionError -> Bool
(DropPositionError -> DropPositionError -> Bool)
-> (DropPositionError -> DropPositionError -> Bool)
-> Eq DropPositionError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DropPositionError -> DropPositionError -> Bool
$c/= :: DropPositionError -> DropPositionError -> Bool
== :: DropPositionError -> DropPositionError -> Bool
$c== :: DropPositionError -> DropPositionError -> Bool
Eq, Int -> DropPositionError -> ShowS
[DropPositionError] -> ShowS
DropPositionError -> String
(Int -> DropPositionError -> ShowS)
-> (DropPositionError -> String)
-> ([DropPositionError] -> ShowS)
-> Show DropPositionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropPositionError] -> ShowS
$cshowList :: [DropPositionError] -> ShowS
show :: DropPositionError -> String
$cshow :: DropPositionError -> String
showsPrec :: Int -> DropPositionError -> ShowS
$cshowsPrec :: Int -> DropPositionError -> ShowS
Show)
data ModifyPropertyError =
ModifyPropertyCannotChangeType String String
deriving (ModifyPropertyError -> ModifyPropertyError -> Bool
(ModifyPropertyError -> ModifyPropertyError -> Bool)
-> (ModifyPropertyError -> ModifyPropertyError -> Bool)
-> Eq ModifyPropertyError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyPropertyError -> ModifyPropertyError -> Bool
$c/= :: ModifyPropertyError -> ModifyPropertyError -> Bool
== :: ModifyPropertyError -> ModifyPropertyError -> Bool
$c== :: ModifyPropertyError -> ModifyPropertyError -> Bool
Eq, Int -> ModifyPropertyError -> ShowS
[ModifyPropertyError] -> ShowS
ModifyPropertyError -> String
(Int -> ModifyPropertyError -> ShowS)
-> (ModifyPropertyError -> String)
-> ([ModifyPropertyError] -> ShowS)
-> Show ModifyPropertyError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyPropertyError] -> ShowS
$cshowList :: [ModifyPropertyError] -> ShowS
show :: ModifyPropertyError -> String
$cshow :: ModifyPropertyError -> String
showsPrec :: Int -> ModifyPropertyError -> ShowS
$cshowsPrec :: Int -> ModifyPropertyError -> ShowS
Show)
data ModifyGameInfoError =
ModifyGameInfoCannotModifyRootInfo GameInfo GameInfo
deriving (ModifyGameInfoError -> ModifyGameInfoError -> Bool
(ModifyGameInfoError -> ModifyGameInfoError -> Bool)
-> (ModifyGameInfoError -> ModifyGameInfoError -> Bool)
-> Eq ModifyGameInfoError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGameInfoError -> ModifyGameInfoError -> Bool
$c/= :: ModifyGameInfoError -> ModifyGameInfoError -> Bool
== :: ModifyGameInfoError -> ModifyGameInfoError -> Bool
$c== :: ModifyGameInfoError -> ModifyGameInfoError -> Bool
Eq, Int -> ModifyGameInfoError -> ShowS
[ModifyGameInfoError] -> ShowS
ModifyGameInfoError -> String
(Int -> ModifyGameInfoError -> ShowS)
-> (ModifyGameInfoError -> String)
-> ([ModifyGameInfoError] -> ShowS)
-> Show ModifyGameInfoError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGameInfoError] -> ShowS
$cshowList :: [ModifyGameInfoError] -> ShowS
show :: ModifyGameInfoError -> String
$cshow :: ModifyGameInfoError -> String
showsPrec :: Int -> ModifyGameInfoError -> ShowS
$cshowsPrec :: Int -> ModifyGameInfoError -> ShowS
Show)
data NodeDeleteError =
NodeDeleteBadIndex
| NodeDeleteOnPathStack
deriving (NodeDeleteError -> NodeDeleteError -> Bool
(NodeDeleteError -> NodeDeleteError -> Bool)
-> (NodeDeleteError -> NodeDeleteError -> Bool)
-> Eq NodeDeleteError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeDeleteError -> NodeDeleteError -> Bool
$c/= :: NodeDeleteError -> NodeDeleteError -> Bool
== :: NodeDeleteError -> NodeDeleteError -> Bool
$c== :: NodeDeleteError -> NodeDeleteError -> Bool
Eq, Int -> NodeDeleteError -> ShowS
[NodeDeleteError] -> ShowS
NodeDeleteError -> String
(Int -> NodeDeleteError -> ShowS)
-> (NodeDeleteError -> String)
-> ([NodeDeleteError] -> ShowS)
-> Show NodeDeleteError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeDeleteError] -> ShowS
$cshowList :: [NodeDeleteError] -> ShowS
show :: NodeDeleteError -> String
$cshow :: NodeDeleteError -> String
showsPrec :: Int -> NodeDeleteError -> ShowS
$cshowsPrec :: Int -> NodeDeleteError -> ShowS
Show)
goUpOrThrow :: (MonadGo m, MonadError GoError m) => m ()
goUpOrThrow :: m ()
goUpOrThrow = m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ()) -> GoError -> m ()
forall a b. (a -> b) -> a -> b
$ NavigationError -> GoError
GoNavigationError NavigationError
NavigationCouldNotMove
goDownOrThrow :: (MonadGo m, MonadError GoError m) => Int -> m ()
goDownOrThrow :: Int -> m ()
goDownOrThrow Int
index = Int -> m Bool
forall (go :: * -> *). MonadGo go => Int -> go Bool
goDown Int
index m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ()) -> GoError -> m ()
forall a b. (a -> b) -> a -> b
$ NavigationError -> GoError
GoNavigationError NavigationError
NavigationCouldNotMove
goLeftOrThrow :: (MonadGo m, MonadError GoError m) => m ()
goLeftOrThrow :: m ()
goLeftOrThrow = m Bool
forall (go :: * -> *). MonadGo go => go Bool
goLeft m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ()) -> GoError -> m ()
forall a b. (a -> b) -> a -> b
$ NavigationError -> GoError
GoNavigationError NavigationError
NavigationCouldNotMove
goRightOrThrow :: (MonadGo m, MonadError GoError m) => m ()
goRightOrThrow :: m ()
goRightOrThrow = m Bool
forall (go :: * -> *). MonadGo go => go Bool
goRight m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ()) -> GoError -> m ()
forall a b. (a -> b) -> a -> b
$ NavigationError -> GoError
GoNavigationError NavigationError
NavigationCouldNotMove
popPositionOrThrow :: (MonadGo m, MonadError GoError m) => m ()
popPositionOrThrow :: m ()
popPositionOrThrow =
m (Either PopPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either PopPositionError ())
popPosition m (Either PopPositionError ())
-> (Either PopPositionError () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(PopPositionError -> m ())
-> (() -> m ()) -> Either PopPositionError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ())
-> (PopPositionError -> GoError) -> PopPositionError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PopPositionError -> GoError
GoPopPositionError) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
dropPositionOrThrow :: (MonadGo m, MonadError GoError m) => m ()
dropPositionOrThrow :: m ()
dropPositionOrThrow =
m (Either DropPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either DropPositionError ())
dropPosition m (Either DropPositionError ())
-> (Either DropPositionError () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(DropPositionError -> m ())
-> (() -> m ()) -> Either DropPositionError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ())
-> (DropPositionError -> GoError) -> DropPositionError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DropPositionError -> GoError
GoDropPositionError) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
modifyPropertyOrThrow :: (MonadGo m, MonadError GoError m, Descriptor d)
=> d
-> (Maybe Property -> Maybe Property)
-> m ()
modifyPropertyOrThrow :: d -> (Maybe Property -> Maybe Property) -> m ()
modifyPropertyOrThrow d
descriptor Maybe Property -> Maybe Property
fn =
d
-> (Maybe Property -> Maybe Property)
-> m (Either ModifyPropertyError ())
forall (go :: * -> *) d.
(MonadGo go, Descriptor d) =>
d
-> (Maybe Property -> Maybe Property)
-> go (Either ModifyPropertyError ())
modifyProperty d
descriptor Maybe Property -> Maybe Property
fn m (Either ModifyPropertyError ())
-> (Either ModifyPropertyError () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(ModifyPropertyError -> m ())
-> (() -> m ()) -> Either ModifyPropertyError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ())
-> (ModifyPropertyError -> GoError) -> ModifyPropertyError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModifyPropertyError -> GoError
GoModifyPropertyError) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
modifyGameInfoOrThrow :: (MonadGo m, MonadError GoError m)
=> (GameInfo -> GameInfo)
-> m (GameInfo, GameInfo)
modifyGameInfoOrThrow :: (GameInfo -> GameInfo) -> m (GameInfo, GameInfo)
modifyGameInfoOrThrow GameInfo -> GameInfo
fn =
(GameInfo -> GameInfo)
-> m (Either ModifyGameInfoError (GameInfo, GameInfo))
forall (go :: * -> *).
MonadGo go =>
(GameInfo -> GameInfo)
-> go (Either ModifyGameInfoError (GameInfo, GameInfo))
modifyGameInfo GameInfo -> GameInfo
fn m (Either ModifyGameInfoError (GameInfo, GameInfo))
-> (Either ModifyGameInfoError (GameInfo, GameInfo)
-> m (GameInfo, GameInfo))
-> m (GameInfo, GameInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(ModifyGameInfoError -> m (GameInfo, GameInfo))
-> ((GameInfo, GameInfo) -> m (GameInfo, GameInfo))
-> Either ModifyGameInfoError (GameInfo, GameInfo)
-> m (GameInfo, GameInfo)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GoError -> m (GameInfo, GameInfo)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m (GameInfo, GameInfo))
-> (ModifyGameInfoError -> GoError)
-> ModifyGameInfoError
-> m (GameInfo, GameInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModifyGameInfoError -> GoError
GoModifyGameInfoError) (GameInfo, GameInfo) -> m (GameInfo, GameInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return
deleteChildAtOrThrow :: (MonadGo m, MonadError GoError m) => Int -> m ()
deleteChildAtOrThrow :: Int -> m ()
deleteChildAtOrThrow Int
index =
Int -> m (Either NodeDeleteError ())
forall (go :: * -> *).
MonadGo go =>
Int -> go (Either NodeDeleteError ())
deleteChildAt Int
index m (Either NodeDeleteError ())
-> (Either NodeDeleteError () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(NodeDeleteError -> m ())
-> (() -> m ()) -> Either NodeDeleteError () -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (GoError -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GoError -> m ())
-> (NodeDeleteError -> GoError) -> NodeDeleteError -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeDeleteError -> GoError
GoNodeDeleteError) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return
newtype GoT m a = GoT { GoT m a -> StateT (GoState (GoT m)) m a
goState :: StateT (GoState (GoT m)) m a }
type GoM = GoT Identity
instance Monad m => Functor (GoT m) where
fmap :: (a -> b) -> GoT m a -> GoT m b
fmap = (a -> b) -> GoT m a -> GoT m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Monad m => Applicative (GoT m) where
pure :: a -> GoT m a
pure = a -> GoT m a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: GoT m (a -> b) -> GoT m a -> GoT m b
(<*>) = GoT m (a -> b) -> GoT m a -> GoT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad m => Monad (GoT m) where
return :: a -> GoT m a
return a
x = StateT (GoState (GoT m)) m a -> GoT m a
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m a -> GoT m a)
-> StateT (GoState (GoT m)) m a -> GoT m a
forall a b. (a -> b) -> a -> b
$ a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
GoT m a
m >>= :: GoT m a -> (a -> GoT m b) -> GoT m b
>>= a -> GoT m b
f = StateT (GoState (GoT m)) m b -> GoT m b
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m b -> GoT m b)
-> StateT (GoState (GoT m)) m b -> GoT m b
forall a b. (a -> b) -> a -> b
$ GoT m b -> StateT (GoState (GoT m)) m b
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState (GoT m b -> StateT (GoState (GoT m)) m b)
-> (a -> GoT m b) -> a -> StateT (GoState (GoT m)) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GoT m b
f (a -> StateT (GoState (GoT m)) m b)
-> StateT (GoState (GoT m)) m a -> StateT (GoState (GoT m)) m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GoT m a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState GoT m a
m
instance MonadFail m => MonadFail (GoT m) where
fail :: String -> GoT m a
fail = StateT (GoState (GoT m)) m a -> GoT m a
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m a -> GoT m a)
-> (String -> StateT (GoState (GoT m)) m a) -> String -> GoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
instance MonadTrans GoT where
lift :: m a -> GoT m a
lift = StateT (GoState (GoT m)) m a -> GoT m a
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m a -> GoT m a)
-> (m a -> StateT (GoState (GoT m)) m a) -> m a -> GoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (GoState (GoT m)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
instance MonadIO m => MonadIO (GoT m) where
liftIO :: IO a -> GoT m a
liftIO = m a -> GoT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GoT m a) -> (IO a -> m a) -> IO a -> GoT 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
liftIO
instance MonadState s m => MonadState s (GoT m) where
get :: GoT m s
get = m s -> GoT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
put :: s -> GoT m ()
put = m () -> GoT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GoT m ()) -> (s -> m ()) -> s -> GoT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
instance MonadWriter w m => MonadWriter w (GoT m) where
writer :: (a, w) -> GoT m a
writer = m a -> GoT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GoT m a) -> ((a, w) -> m a) -> (a, w) -> GoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
tell :: w -> GoT m ()
tell = m () -> GoT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> GoT m ()) -> (w -> m ()) -> w -> GoT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
listen :: GoT m a -> GoT m (a, w)
listen = StateT (GoState (GoT m)) m (a, w) -> GoT m (a, w)
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m (a, w) -> GoT m (a, w))
-> (GoT m a -> StateT (GoState (GoT m)) m (a, w))
-> GoT m a
-> GoT m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (GoState (GoT m)) m a -> StateT (GoState (GoT m)) m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (StateT (GoState (GoT m)) m a -> StateT (GoState (GoT m)) m (a, w))
-> (GoT m a -> StateT (GoState (GoT m)) m a)
-> GoT m a
-> StateT (GoState (GoT m)) m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoT m a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState
pass :: GoT m (a, w -> w) -> GoT m a
pass = StateT (GoState (GoT m)) m a -> GoT m a
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m a -> GoT m a)
-> (GoT m (a, w -> w) -> StateT (GoState (GoT m)) m a)
-> GoT m (a, w -> w)
-> GoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT (GoState (GoT m)) m (a, w -> w)
-> StateT (GoState (GoT m)) m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (StateT (GoState (GoT m)) m (a, w -> w)
-> StateT (GoState (GoT m)) m a)
-> (GoT m (a, w -> w) -> StateT (GoState (GoT m)) m (a, w -> w))
-> GoT m (a, w -> w)
-> StateT (GoState (GoT m)) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoT m (a, w -> w) -> StateT (GoState (GoT m)) m (a, w -> w)
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState
instance MonadError e m => MonadError e (GoT m) where
throwError :: e -> GoT m a
throwError = m a -> GoT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> GoT m a) -> (e -> m a) -> e -> GoT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: GoT m a -> (e -> GoT m a) -> GoT m a
catchError GoT m a
action e -> GoT m a
handler =
StateT (GoState (GoT m)) m a -> GoT m a
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m a -> GoT m a)
-> StateT (GoState (GoT m)) m a -> GoT m a
forall a b. (a -> b) -> a -> b
$ StateT (GoState (GoT m)) m a
-> (e -> StateT (GoState (GoT m)) m a)
-> StateT (GoState (GoT m)) m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (GoT m a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState GoT m a
action) (GoT m a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState (GoT m a -> StateT (GoState (GoT m)) m a)
-> (e -> GoT m a) -> e -> StateT (GoState (GoT m)) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> GoT m a
handler)
runGoT :: Monad m => GoT m a -> Cursor -> m (a, Cursor)
runGoT :: GoT m a -> Cursor -> m (a, Cursor)
runGoT GoT m a
go Cursor
cursor = do
(a
value, GoState (GoT m)
state) <- StateT (GoState (GoT m)) m a
-> GoState (GoT m) -> m (a, GoState (GoT m))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
State.runStateT (GoT m a -> StateT (GoState (GoT m)) m a
forall (m :: * -> *) a. GoT m a -> StateT (GoState (GoT m)) m a
goState GoT m a
go) (Cursor -> GoState (GoT m)
forall (m :: * -> *). Cursor -> GoState m
initialState Cursor
cursor)
(a, Cursor) -> m (a, Cursor)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
value, GoState (GoT m) -> Cursor
forall (go :: * -> *). GoState go -> Cursor
stateCursor GoState (GoT m)
state)
evalGoT :: Monad m => GoT m a -> Cursor -> m a
evalGoT :: GoT m a -> Cursor -> m a
evalGoT GoT m a
go Cursor
cursor = ((a, Cursor) -> a) -> m (a, Cursor) -> m a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, Cursor) -> a
forall a b. (a, b) -> a
fst (m (a, Cursor) -> m a) -> m (a, Cursor) -> m a
forall a b. (a -> b) -> a -> b
$ GoT m a -> Cursor -> m (a, Cursor)
forall (m :: * -> *) a.
Monad m =>
GoT m a -> Cursor -> m (a, Cursor)
runGoT GoT m a
go Cursor
cursor
execGoT :: Monad m => GoT m a -> Cursor -> m Cursor
execGoT :: GoT m a -> Cursor -> m Cursor
execGoT GoT m a
go Cursor
cursor = ((a, Cursor) -> Cursor) -> m (a, Cursor) -> m Cursor
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a, Cursor) -> Cursor
forall a b. (a, b) -> b
snd (m (a, Cursor) -> m Cursor) -> m (a, Cursor) -> m Cursor
forall a b. (a -> b) -> a -> b
$ GoT m a -> Cursor -> m (a, Cursor)
forall (m :: * -> *) a.
Monad m =>
GoT m a -> Cursor -> m (a, Cursor)
runGoT GoT m a
go Cursor
cursor
runGo :: GoM a -> Cursor -> (a, Cursor)
runGo :: GoM a -> Cursor -> (a, Cursor)
runGo GoM a
go = Identity (a, Cursor) -> (a, Cursor)
forall a. Identity a -> a
runIdentity (Identity (a, Cursor) -> (a, Cursor))
-> (Cursor -> Identity (a, Cursor)) -> Cursor -> (a, Cursor)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoM a -> Cursor -> Identity (a, Cursor)
forall (m :: * -> *) a.
Monad m =>
GoT m a -> Cursor -> m (a, Cursor)
runGoT GoM a
go
evalGo :: GoM a -> Cursor -> a
evalGo :: GoM a -> Cursor -> a
evalGo GoM a
m Cursor
cursor = (a, Cursor) -> a
forall a b. (a, b) -> a
fst ((a, Cursor) -> a) -> (a, Cursor) -> a
forall a b. (a -> b) -> a -> b
$ GoM a -> Cursor -> (a, Cursor)
forall a. GoM a -> Cursor -> (a, Cursor)
runGo GoM a
m Cursor
cursor
execGo :: GoM a -> Cursor -> Cursor
execGo :: GoM a -> Cursor -> Cursor
execGo GoM a
m Cursor
cursor = (a, Cursor) -> Cursor
forall a b. (a, b) -> b
snd ((a, Cursor) -> Cursor) -> (a, Cursor) -> Cursor
forall a b. (a -> b) -> a -> b
$ GoM a -> Cursor -> (a, Cursor)
forall a. GoM a -> Cursor -> (a, Cursor)
runGo GoM a
m Cursor
cursor
getState :: Monad m => GoT m (GoState (GoT m))
getState :: GoT m (GoState (GoT m))
getState = StateT (GoState (GoT m)) m (GoState (GoT m))
-> GoT m (GoState (GoT m))
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT StateT (GoState (GoT m)) m (GoState (GoT m))
forall s (m :: * -> *). MonadState s m => m s
State.get
putState :: Monad m => GoState (GoT m) -> GoT m ()
putState :: GoState (GoT m) -> GoT m ()
putState = StateT (GoState (GoT m)) m () -> GoT m ()
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m () -> GoT m ())
-> (GoState (GoT m) -> StateT (GoState (GoT m)) m ())
-> GoState (GoT m)
-> GoT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoState (GoT m) -> StateT (GoState (GoT m)) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
State.put
modifyState :: Monad m => (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState :: (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState = StateT (GoState (GoT m)) m () -> GoT m ()
forall (m :: * -> *) a. StateT (GoState (GoT m)) m a -> GoT m a
GoT (StateT (GoState (GoT m)) m () -> GoT m ())
-> ((GoState (GoT m) -> GoState (GoT m))
-> StateT (GoState (GoT m)) m ())
-> (GoState (GoT m) -> GoState (GoT m))
-> GoT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoState (GoT m) -> GoState (GoT m))
-> StateT (GoState (GoT m)) m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify
instance Monad m => MonadGo (GoT m) where
getCursor :: GoT m Cursor
getCursor = (GoState (GoT m) -> Cursor)
-> GoT m (GoState (GoT m)) -> GoT m Cursor
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GoState (GoT m) -> Cursor
forall (go :: * -> *). GoState go -> Cursor
stateCursor GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
goUp :: GoT m Bool
goUp = do
Int
index <- (Cursor -> Int) -> GoT m Cursor -> GoT m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Cursor -> Int
cursorChildIndex GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
(PathStack -> PathStack) -> GoT m Bool
forall (m :: * -> *).
Monad m =>
(PathStack -> PathStack) -> GoT m Bool
goUp' ((PathStack -> PathStack) -> GoT m Bool)
-> (PathStack -> PathStack) -> GoT m Bool
forall a b. (a -> b) -> a -> b
$ \PathStack
pathStack -> case PathStack
pathStack of
[] -> PathStack
pathStack
[Step]
path:PathStack
paths -> (Int -> Step
GoDown Int
indexStep -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
path)[Step] -> PathStack -> PathStack
forall a. a -> [a] -> [a]
:PathStack
paths
goDown :: Int -> GoT m Bool
goDown Int
index = Int -> (PathStack -> PathStack) -> GoT m Bool
forall (m :: * -> *).
Monad m =>
Int -> (PathStack -> PathStack) -> GoT m Bool
goDown' Int
index ((PathStack -> PathStack) -> GoT m Bool)
-> (PathStack -> PathStack) -> GoT m Bool
forall a b. (a -> b) -> a -> b
$ \PathStack
pathStack -> case PathStack
pathStack of
[] -> PathStack
pathStack
[Step]
path:PathStack
paths -> (Int -> Step
GoUp Int
indexStep -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
path)[Step] -> PathStack -> PathStack
forall a. a -> [a] -> [a]
:PathStack
paths
goLeft :: GoT m Bool
goLeft = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
case (Cursor -> Maybe Cursor
cursorParent Cursor
cursor, Cursor -> Int
cursorChildIndex Cursor
cursor) of
(Maybe Cursor
Nothing, Int
_) -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Just Cursor
_, Int
0) -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Just Cursor
_, Int
n) -> GoT m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp GoT m Bool -> (Bool -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Int -> GoT m Bool
forall (go :: * -> *). MonadGo go => Int -> go Bool
goDown (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) GoT m Bool -> (Bool -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False -> String -> GoT m Bool
forall a. HasCallStack => String -> a
error String
"GoT.goLeft: Internal error, could not go down."
Bool
False -> String -> GoT m Bool
forall a. HasCallStack => String -> a
error String
"GoT.goLeft: Internal error, could not go up."
goRight :: GoT m Bool
goRight = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
case (Cursor -> Maybe Cursor
cursorParent Cursor
cursor, Cursor -> Int
cursorChildIndex Cursor
cursor) of
(Maybe Cursor
Nothing, Int
_) -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Just Cursor
parent, Int
n) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor -> Int
cursorChildCount Cursor
parent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
(Just Cursor
_, Int
n) -> GoT m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp GoT m Bool -> (Bool -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Int -> GoT m Bool
forall (go :: * -> *). MonadGo go => Int -> go Bool
goDown (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) GoT m Bool -> (Bool -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False -> String -> GoT m Bool
forall a. HasCallStack => String -> a
error String
"GoT.goRight: Internal error, could not go down."
Bool
False -> String -> GoT m Bool
forall a. HasCallStack => String -> a
error String
"GoT.goRight: Internal error, could not go up."
goToRoot :: GoT m ()
goToRoot = GoT m Bool -> GoT m () -> GoT m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whileM GoT m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$ () -> GoT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
goToGameInfoNode :: Bool -> GoT m Bool
goToGameInfoNode Bool
goToRootIfNotFound = GoT m ()
forall (go :: * -> *). MonadGo go => go ()
pushPosition GoT m () -> GoT m Bool -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GoT m Bool
findGameInfoNode
where findGameInfoNode :: GoT m Bool
findGameInfoNode = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
if Cursor -> Bool
hasGameInfo Cursor
cursor
then GoT m (Either DropPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either DropPositionError ())
dropPosition GoT m (Either DropPositionError ())
-> (Either DropPositionError () -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right () -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Left DropPositionError
DropPositionStackEmpty -> GoT m Bool
forall a. a
errorDropStackEmpty
else if Maybe Cursor -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Cursor -> Bool) -> Maybe Cursor -> Bool
forall a b. (a -> b) -> a -> b
$ Cursor -> Maybe Cursor
cursorParent Cursor
cursor
then if Bool
goToRootIfNotFound
then GoT m (Either DropPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either DropPositionError ())
dropPosition GoT m (Either DropPositionError ())
-> (Either DropPositionError () -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right () -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Left DropPositionError
DropPositionStackEmpty -> GoT m Bool
forall a. a
errorDropStackEmpty
else GoT m (Either PopPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either PopPositionError ())
popPosition GoT m (Either PopPositionError ())
-> (Either PopPositionError () -> GoT m Bool) -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right () -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Left PopPositionError
PopPositionStackEmpty -> GoT m Bool
forall a. a
errorPopStackEmpty
Left PopPositionError
PopPositionCannotRetraceSteps -> GoT m Bool
forall a. a
errorPopCannotRetrace
else GoT m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp GoT m Bool -> GoT m Bool -> GoT m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GoT m Bool
findGameInfoNode
hasGameInfo :: Cursor -> Bool
hasGameInfo Cursor
cursor = Node -> Bool
internalIsGameInfoNode (Node -> Bool) -> Node -> Bool
forall a b. (a -> b) -> a -> b
$ Cursor -> Node
cursorNode Cursor
cursor
errorDropStackEmpty :: a
errorDropStackEmpty =
String -> a
forall a. HasCallStack => String -> a
error String
"GoT.goToGameInfoNode: Internal error, DropPositionStackEmpty."
errorPopStackEmpty :: a
errorPopStackEmpty =
String -> a
forall a. HasCallStack => String -> a
error String
"GoT.goToGameInfoNode: Internal error, PopPositionStackEmpty."
errorPopCannotRetrace :: a
errorPopCannotRetrace =
String -> a
forall a. HasCallStack => String -> a
error String
"GoT.goToGameInfoNode: Internal error, PopPositionCannotRetraceSteps."
pushPosition :: GoT m ()
pushPosition = (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \GoState (GoT m)
state ->
GoState (GoT m)
state { statePathStack :: PathStack
statePathStack = [][Step] -> PathStack -> PathStack
forall a. a -> [a] -> [a]
:GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoState (GoT m)
state }
popPosition :: GoT m (Either PopPositionError ())
popPosition = do
GoT m PathStack
forall (m :: * -> *). Monad m => GoT m PathStack
getPathStack GoT m PathStack
-> (PathStack -> GoT m (Either PopPositionError ()))
-> GoT m (Either PopPositionError ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Either PopPositionError () -> GoT m (Either PopPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PopPositionError () -> GoT m (Either PopPositionError ()))
-> Either PopPositionError () -> GoT m (Either PopPositionError ())
forall a b. (a -> b) -> a -> b
$ PopPositionError -> Either PopPositionError ()
forall a b. a -> Either a b
Left PopPositionError
PopPositionStackEmpty
PathStack
_ -> do
Maybe PopPositionError
maybeRetraceErrorResult <- GoT m (Either (Maybe PopPositionError) Step)
-> (Step -> GoT m (Maybe (Maybe PopPositionError)))
-> GoT m (Maybe PopPositionError)
forall (m :: * -> *) r a.
Monad m =>
m (Either r a) -> (a -> m (Maybe r)) -> m r
whileM''
(do ~([Step]
path:PathStack
_) <- GoT m PathStack
forall (m :: * -> *). Monad m => GoT m PathStack
getPathStack
Either (Maybe PopPositionError) Step
-> GoT m (Either (Maybe PopPositionError) Step)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe PopPositionError) Step
-> GoT m (Either (Maybe PopPositionError) Step))
-> Either (Maybe PopPositionError) Step
-> GoT m (Either (Maybe PopPositionError) Step)
forall a b. (a -> b) -> a -> b
$ if [Step] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Step]
path then Maybe PopPositionError -> Either (Maybe PopPositionError) Step
forall a b. a -> Either a b
Left Maybe PopPositionError
forall a. Maybe a
Nothing else Step -> Either (Maybe PopPositionError) Step
forall a b. b -> Either a b
Right (Step -> Either (Maybe PopPositionError) Step)
-> Step -> Either (Maybe PopPositionError) Step
forall a b. (a -> b) -> a -> b
$ [Step] -> Step
forall a. [a] -> a
head [Step]
path)
(\Step
step -> do
Bool
ok <- Step -> (PathStack -> PathStack) -> GoT m Bool
forall (m :: * -> *).
Monad m =>
Step -> (PathStack -> PathStack) -> GoT m Bool
takeStepM Step
step ((PathStack -> PathStack) -> GoT m Bool)
-> (PathStack -> PathStack) -> GoT m Bool
forall a b. (a -> b) -> a -> b
$ \((Step
_:[Step]
steps):PathStack
paths) -> [Step]
steps[Step] -> PathStack -> PathStack
forall a. a -> [a] -> [a]
:PathStack
paths
Maybe (Maybe PopPositionError)
-> GoT m (Maybe (Maybe PopPositionError))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Maybe PopPositionError)
-> GoT m (Maybe (Maybe PopPositionError)))
-> Maybe (Maybe PopPositionError)
-> GoT m (Maybe (Maybe PopPositionError))
forall a b. (a -> b) -> a -> b
$ if Bool
ok then Maybe (Maybe PopPositionError)
forall a. Maybe a
Nothing else Maybe PopPositionError -> Maybe (Maybe PopPositionError)
forall a. a -> Maybe a
Just (Maybe PopPositionError -> Maybe (Maybe PopPositionError))
-> Maybe PopPositionError -> Maybe (Maybe PopPositionError)
forall a b. (a -> b) -> a -> b
$ PopPositionError -> Maybe PopPositionError
forall a. a -> Maybe a
Just PopPositionError
PopPositionCannotRetraceSteps)
case Maybe PopPositionError
maybeRetraceErrorResult of
Just PopPositionError
err -> Either PopPositionError () -> GoT m (Either PopPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PopPositionError () -> GoT m (Either PopPositionError ()))
-> Either PopPositionError () -> GoT m (Either PopPositionError ())
forall a b. (a -> b) -> a -> b
$ PopPositionError -> Either PopPositionError ()
forall a b. a -> Either a b
Left PopPositionError
err
Maybe PopPositionError
Nothing -> do
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \GoState (GoT m)
state -> case GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoState (GoT m)
state of
[]:PathStack
rest -> GoState (GoT m)
state { statePathStack :: PathStack
statePathStack = PathStack
rest }
PathStack
_ -> String -> GoState (GoT m)
forall a. HasCallStack => String -> a
error String
"popPosition: Internal failure, top of path stack is not empty."
Either PopPositionError () -> GoT m (Either PopPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PopPositionError () -> GoT m (Either PopPositionError ()))
-> Either PopPositionError () -> GoT m (Either PopPositionError ())
forall a b. (a -> b) -> a -> b
$ () -> Either PopPositionError ()
forall a b. b -> Either a b
Right ()
dropPosition :: GoT m (Either DropPositionError ())
dropPosition = do
GoState (GoT m)
state <- GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
case GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoState (GoT m)
state of
[Step]
x:[Step]
y:PathStack
xs -> do GoState (GoT m) -> GoT m ()
forall (m :: * -> *). Monad m => GoState (GoT m) -> GoT m ()
putState (GoState (GoT m) -> GoT m ()) -> GoState (GoT m) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ GoState (GoT m)
state { statePathStack :: PathStack
statePathStack = ([Step]
x [Step] -> [Step] -> [Step]
forall a. [a] -> [a] -> [a]
++ [Step]
y)[Step] -> PathStack -> PathStack
forall a. a -> [a] -> [a]
:PathStack
xs }
Either DropPositionError () -> GoT m (Either DropPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DropPositionError ()
-> GoT m (Either DropPositionError ()))
-> Either DropPositionError ()
-> GoT m (Either DropPositionError ())
forall a b. (a -> b) -> a -> b
$ () -> Either DropPositionError ()
forall a b. b -> Either a b
Right ()
[[Step]
_] -> do GoState (GoT m) -> GoT m ()
forall (m :: * -> *). Monad m => GoState (GoT m) -> GoT m ()
putState (GoState (GoT m) -> GoT m ()) -> GoState (GoT m) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ GoState (GoT m)
state { statePathStack :: PathStack
statePathStack = [] }
Either DropPositionError () -> GoT m (Either DropPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DropPositionError ()
-> GoT m (Either DropPositionError ()))
-> Either DropPositionError ()
-> GoT m (Either DropPositionError ())
forall a b. (a -> b) -> a -> b
$ () -> Either DropPositionError ()
forall a b. b -> Either a b
Right ()
[] -> Either DropPositionError () -> GoT m (Either DropPositionError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either DropPositionError ()
-> GoT m (Either DropPositionError ()))
-> Either DropPositionError ()
-> GoT m (Either DropPositionError ())
forall a b. (a -> b) -> a -> b
$ DropPositionError -> Either DropPositionError ()
forall a b. a -> Either a b
Left DropPositionError
DropPositionStackEmpty
modifyProperties :: ([Property] -> [Property]) -> GoT m ()
modifyProperties [Property] -> [Property]
fn = do
Cursor
oldCursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
let oldProperties :: [Property]
oldProperties = Cursor -> [Property]
cursorProperties Cursor
oldCursor
newProperties :: [Property]
newProperties = [Property] -> [Property]
fn [Property]
oldProperties
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \GoState (GoT m)
state ->
GoState (GoT m)
state { stateCursor :: Cursor
stateCursor = (Node -> Node) -> Cursor -> Cursor
cursorModifyNode
(\Node
node -> Node
node { nodeProperties :: [Property]
nodeProperties = [Property]
newProperties })
Cursor
oldCursor
}
Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Property -> Property -> Ordering) -> [Property] -> [Property]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Property -> String) -> Property -> Property -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Property -> String
forall a. Descriptor a => a -> String
propertyName) [Property]
newProperties [Property] -> [Property] -> Bool
forall a. Eq a => a -> a -> Bool
/=
(Property -> Property -> Ordering) -> [Property] -> [Property]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Property -> String) -> Property -> Property -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Property -> String
forall a. Descriptor a => a -> String
propertyName) [Property]
oldProperties) (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$
Event (GoT m) (PropertiesModifiedHandler (GoT m))
-> (PropertiesModifiedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (PropertiesModifiedHandler (GoT m))
forall (go :: * -> *). Event go (PropertiesModifiedHandler go)
propertiesModifiedEvent (\PropertiesModifiedHandler (GoT m)
f -> PropertiesModifiedHandler (GoT m)
f [Property]
oldProperties [Property]
newProperties)
let filterToGameInfo :: [Property] -> [Property]
filterToGameInfo = [Property] -> [Property]
forall a. Eq a => [a] -> [a]
nub ([Property] -> [Property])
-> ([Property] -> [Property]) -> [Property] -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PropertyType
GameInfoProperty PropertyType -> PropertyType -> Bool
forall a. Eq a => a -> a -> Bool
==) (PropertyType -> Bool)
-> (Property -> PropertyType) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType)
oldGameInfo :: [Property]
oldGameInfo = [Property] -> [Property]
filterToGameInfo [Property]
oldProperties
newGameInfo :: [Property]
newGameInfo = [Property] -> [Property]
filterToGameInfo [Property]
newProperties
Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Property]
newGameInfo [Property] -> [Property] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Property]
oldGameInfo) (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$ do
Cursor
newCursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
Event (GoT m) (GameInfoChangedHandler (GoT m))
-> (GameInfoChangedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (GameInfoChangedHandler (GoT m))
forall (go :: * -> *). Event go (GameInfoChangedHandler go)
gameInfoChangedEvent (\GameInfoChangedHandler (GoT m)
f -> GameInfoChangedHandler (GoT m)
f (BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
oldCursor)
(BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
newCursor))
getProperty :: d -> GoT m (Maybe Property)
getProperty d
descriptor = (Property -> Bool) -> [Property] -> Maybe Property
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (d -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate d
descriptor) ([Property] -> Maybe Property)
-> GoT m [Property] -> GoT m (Maybe Property)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GoT m [Property]
forall (go :: * -> *). MonadGo go => go [Property]
getProperties
modifyProperty :: d
-> (Maybe Property -> Maybe Property)
-> GoT m (Either ModifyPropertyError ())
modifyProperty d
descriptor Maybe Property -> Maybe Property
fn = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
let node :: Node
node = Cursor -> Node
cursorNode Cursor
cursor
old :: Maybe Property
old = d -> Node -> Maybe Property
forall a. Descriptor a => a -> Node -> Maybe Property
findProperty d
descriptor Node
node
new :: Maybe Property
new = Maybe Property -> Maybe Property
fn Maybe Property
old
if (Bool -> (Property -> Bool) -> Maybe Property -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate d
descriptor) Maybe Property
new)
then Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ()))
-> Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ())
forall a b. (a -> b) -> a -> b
$ ModifyPropertyError -> Either ModifyPropertyError ()
forall a b. a -> Either a b
Left (ModifyPropertyError -> Either ModifyPropertyError ())
-> ModifyPropertyError -> Either ModifyPropertyError ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ModifyPropertyError
ModifyPropertyCannotChangeType (Maybe Property -> String
forall a. Show a => a -> String
show Maybe Property
old) (Maybe Property -> String
forall a. Show a => a -> String
show Maybe Property
new)
else do
case (Maybe Property
old, Maybe Property
new) of
(Just Property
_, Maybe Property
Nothing) -> ([Property] -> [Property]) -> GoT m ()
forall (go :: * -> *).
MonadGo go =>
([Property] -> [Property]) -> go ()
modifyProperties (([Property] -> [Property]) -> GoT m ())
-> ([Property] -> [Property]) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ d -> [Property] -> [Property]
forall a. Descriptor a => a -> [Property] -> [Property]
remove d
descriptor
(Maybe Property
Nothing, Just Property
value') -> ([Property] -> [Property]) -> GoT m ()
forall (go :: * -> *).
MonadGo go =>
([Property] -> [Property]) -> go ()
modifyProperties (([Property] -> [Property]) -> GoT m ())
-> ([Property] -> [Property]) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
add Property
value'
(Just Property
value, Just Property
value') | Property
value Property -> Property -> Bool
forall a. Eq a => a -> a -> Bool
/= Property
value' -> do
([Property] -> [Property]) -> GoT m ()
forall (go :: * -> *).
MonadGo go =>
([Property] -> [Property]) -> go ()
modifyProperties (([Property] -> [Property]) -> GoT m ())
-> ([Property] -> [Property]) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ Property -> [Property] -> [Property]
forall a. a -> [a] -> [a]
add Property
value' ([Property] -> [Property])
-> ([Property] -> [Property]) -> [Property] -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> [Property] -> [Property]
forall a. Descriptor a => a -> [Property] -> [Property]
remove d
descriptor
(Maybe Property, Maybe Property)
_ -> () -> GoT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ()))
-> Either ModifyPropertyError ()
-> GoT m (Either ModifyPropertyError ())
forall a b. (a -> b) -> a -> b
$ () -> Either ModifyPropertyError ()
forall a b. b -> Either a b
Right ()
where remove :: a -> [Property] -> [Property]
remove a
descriptor = (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Property -> Bool) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate a
descriptor)
add :: a -> [a] -> [a]
add a
value = (a
valuea -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
modifyGameInfo :: (GameInfo -> GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo))
modifyGameInfo GameInfo -> GameInfo
fn = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
let info :: GameInfo
info = BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
cursor
info' :: GameInfo
info' = GameInfo -> GameInfo
fn GameInfo
info
if GameInfo -> RootInfo
gameInfoRootInfo GameInfo
info RootInfo -> RootInfo -> Bool
forall a. Eq a => a -> a -> Bool
/= GameInfo -> RootInfo
gameInfoRootInfo GameInfo
info'
then Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo)))
-> Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo))
forall a b. (a -> b) -> a -> b
$ ModifyGameInfoError
-> Either ModifyGameInfoError (GameInfo, GameInfo)
forall a b. a -> Either a b
Left (ModifyGameInfoError
-> Either ModifyGameInfoError (GameInfo, GameInfo))
-> ModifyGameInfoError
-> Either ModifyGameInfoError (GameInfo, GameInfo)
forall a b. (a -> b) -> a -> b
$ GameInfo -> GameInfo -> ModifyGameInfoError
ModifyGameInfoCannotModifyRootInfo GameInfo
info GameInfo
info'
else do
GoT m ()
forall (go :: * -> *). MonadGo go => go ()
pushPosition
Bool
_ <- Bool -> GoT m Bool
forall (go :: * -> *). MonadGo go => Bool -> go Bool
goToGameInfoNode Bool
True
([Property] -> [Property]) -> GoT m ()
forall (go :: * -> *).
MonadGo go =>
([Property] -> [Property]) -> go ()
modifyProperties (([Property] -> [Property]) -> GoT m ())
-> ([Property] -> [Property]) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \[Property]
props ->
GameInfo -> [Property]
gameInfoToProperties GameInfo
info' [Property] -> [Property] -> [Property]
forall a. [a] -> [a] -> [a]
++ (Property -> Bool) -> [Property] -> [Property]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PropertyType
GameInfoProperty PropertyType -> PropertyType -> Bool
forall a. Eq a => a -> a -> Bool
/=) (PropertyType -> Bool)
-> (Property -> PropertyType) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType) [Property]
props
GoT m (Either PopPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either PopPositionError ())
popPosition GoT m (Either PopPositionError ())
-> (Either PopPositionError () -> GoT m ()) -> GoT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right () -> () -> GoT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left PopPositionError
PopPositionStackEmpty ->
String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.modifyGameInfo: Internal error, PopPositionStackEmpty."
Left PopPositionError
PopPositionCannotRetraceSteps ->
String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.modifyGameInfo: Internal error, PopPositionCannotRetraceSteps."
Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo)))
-> Either ModifyGameInfoError (GameInfo, GameInfo)
-> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo))
forall a b. (a -> b) -> a -> b
$ (GameInfo, GameInfo)
-> Either ModifyGameInfoError (GameInfo, GameInfo)
forall a b. b -> Either a b
Right (GameInfo
info, GameInfo
info')
modifyVariationMode :: (VariationMode -> VariationMode) -> GoT m ()
modifyVariationMode VariationMode -> VariationMode
fn = do
GoT m ()
forall (go :: * -> *). MonadGo go => go ()
pushPosition
GoT m ()
forall (go :: * -> *). MonadGo go => go ()
goToRoot
ValuedPropertyInfo VariationMode
-> (Maybe VariationMode -> Maybe VariationMode) -> GoT m ()
forall (go :: * -> *) v d.
(MonadGo go, ValuedDescriptor v d) =>
d -> (Maybe v -> Maybe v) -> go ()
modifyPropertyValue ValuedPropertyInfo VariationMode
propertyST ((Maybe VariationMode -> Maybe VariationMode) -> GoT m ())
-> (Maybe VariationMode -> Maybe VariationMode) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \Maybe VariationMode
maybeOld ->
let old :: VariationMode
old = VariationMode -> Maybe VariationMode -> VariationMode
forall a. a -> Maybe a -> a
fromMaybe VariationMode
defaultVariationMode Maybe VariationMode
maybeOld
new :: VariationMode
new = VariationMode -> VariationMode
fn VariationMode
old
in if VariationMode
new VariationMode -> VariationMode -> Bool
forall a. Eq a => a -> a -> Bool
== VariationMode
old
then Maybe VariationMode
maybeOld
else if VariationMode
new VariationMode -> VariationMode -> Bool
forall a. Eq a => a -> a -> Bool
== VariationMode
defaultVariationMode
then Maybe VariationMode
forall a. Maybe a
Nothing
else VariationMode -> Maybe VariationMode
forall a. a -> Maybe a
Just VariationMode
new
Either PopPositionError ()
result <- GoT m (Either PopPositionError ())
forall (go :: * -> *).
MonadGo go =>
go (Either PopPositionError ())
popPosition
case Either PopPositionError ()
result of
Right () -> () -> GoT m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left PopPositionError
PopPositionStackEmpty ->
String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.modifyVariationMode: Internal error, got PopPositionStackEmpty."
Left PopPositionError
PopPositionCannotRetraceSteps ->
String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.modifyVariationMode: Internal error, got PopPositionCannotRetraceSteps."
addChildAt :: Int -> Node -> GoT m ()
addChildAt Int
index Node
node = do
Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
let childCount :: Int
childCount = Cursor -> Int
cursorChildCount Cursor
cursor
indexCapped :: Int
indexCapped = if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
0
else if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
childCount then Int
childCount
else Int
index
let cursor' :: Cursor
cursor' = (Node -> Node) -> Cursor -> Cursor
cursorModifyNode (Int -> Node -> Node -> Node
Tree.addChildAt Int
indexCapped Node
node) Cursor
cursor
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \GoState (GoT m)
state ->
GoState (GoT m)
state { stateCursor :: Cursor
stateCursor = Cursor
cursor'
, statePathStack :: PathStack
statePathStack = (Step -> Step)
-> (Step -> Step)
-> (Step -> Step)
-> Cursor
-> PathStack
-> PathStack
forall a.
(Step -> a)
-> (Step -> a) -> (Step -> a) -> Cursor -> PathStack -> [[a]]
foldPathStack
(\Step
step -> case Step
step of
GoUp Int
n -> Int -> Step
GoUp (Int -> Step) -> Int -> Step
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexCapped then Int
n else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
down :: Step
down@(GoDown Int
_) -> Step
down)
(\Step
step -> case Step
step of
up :: Step
up@(GoUp Int
_) -> Step
up
GoDown Int
n -> Int -> Step
GoDown (Int -> Step) -> Int -> Step
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
indexCapped then Int
n else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
Step -> Step
forall a. a -> a
id
Cursor
cursor'
(GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoState (GoT m)
state)
}
Event (GoT m) (ChildAddedHandler (GoT m))
-> (ChildAddedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (ChildAddedHandler (GoT m))
forall (go :: * -> *). Event go (ChildAddedHandler go)
childAddedEvent (ChildAddedHandler (GoT m) -> ChildAddedHandler (GoT m)
forall a b. (a -> b) -> a -> b
$ Int
indexCapped)
deleteChildAt :: Int -> GoT m (Either NodeDeleteError ())
deleteChildAt Int
index = do
Int
childCount <- Cursor -> Int
cursorChildCount (Cursor -> Int) -> GoT m Cursor -> GoT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
childCount
then Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NodeDeleteError () -> GoT m (Either NodeDeleteError ()))
-> Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall a b. (a -> b) -> a -> b
$ NodeDeleteError -> Either NodeDeleteError ()
forall a b. a -> Either a b
Left NodeDeleteError
NodeDeleteBadIndex
else do Int -> GoT m Bool
forall (go :: * -> *). MonadGo go => Int -> go Bool
goDown Int
index GoT m Bool -> (Bool -> GoT m ()) -> GoT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
\Bool
ok -> Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$ String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.deleteChildAt: Internal error, index isn't valid."
Cursor
childCursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
Bool
deletingNodeOnPath <- Cursor -> PathStack -> Bool
doesPathStackEnterCurrentNode (Cursor -> PathStack -> Bool)
-> GoT m Cursor -> GoT m (PathStack -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Cursor -> GoT m Cursor
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor
childCursor GoT m (PathStack -> Bool) -> GoT m PathStack -> GoT m Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GoT m PathStack
forall (m :: * -> *). Monad m => GoT m PathStack
getPathStack
GoT m Bool
forall (go :: * -> *). MonadGo go => go Bool
goUp GoT m Bool -> (Bool -> GoT m ()) -> GoT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
ok -> Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$ String -> GoT m ()
forall a. HasCallStack => String -> a
error String
"GoT.deleteChildAt: Internal error, can't go up."
if Bool
deletingNodeOnPath
then Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NodeDeleteError () -> GoT m (Either NodeDeleteError ()))
-> Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall a b. (a -> b) -> a -> b
$ NodeDeleteError -> Either NodeDeleteError ()
forall a b. a -> Either a b
Left NodeDeleteError
NodeDeleteOnPathStack
else do Cursor
cursor <- GoT m Cursor
forall (go :: * -> *). MonadGo go => go Cursor
getCursor
let cursor' :: Cursor
cursor' = (Node -> Node) -> Cursor -> Cursor
cursorModifyNode (Int -> Node -> Node
Tree.deleteChildAt Int
index) Cursor
cursor
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ \GoState (GoT m)
state ->
GoState (GoT m)
state { stateCursor :: Cursor
stateCursor = Cursor
cursor'
, statePathStack :: PathStack
statePathStack =
(Step -> Step)
-> (Step -> Step)
-> (Step -> Step)
-> Cursor
-> PathStack
-> PathStack
forall a.
(Step -> a)
-> (Step -> a) -> (Step -> a) -> Cursor -> PathStack -> [[a]]
foldPathStack
(\Step
step -> case Step
step of
GoUp Int
n -> Int -> Step
GoUp (Int -> Step) -> Int -> Step
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
index then Int
n else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
down :: Step
down@(GoDown Int
_) -> Step
down)
(\Step
step -> case Step
step of
up :: Step
up@(GoUp Int
_) -> Step
up
GoDown Int
n -> Int -> Step
GoDown (Int -> Step) -> Int -> Step
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
index then Int
n else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
Step -> Step
forall a. a -> a
id
Cursor
cursor'
(GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoState (GoT m)
state)
}
Event (GoT m) (ChildDeletedHandler (GoT m))
-> (ChildDeletedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (ChildDeletedHandler (GoT m))
forall (go :: * -> *). Event go (ChildDeletedHandler go)
childDeletedEvent (ChildDeletedHandler (GoT m) -> ChildDeletedHandler (GoT m)
forall a b. (a -> b) -> a -> b
$ Cursor
childCursor)
Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either NodeDeleteError () -> GoT m (Either NodeDeleteError ()))
-> Either NodeDeleteError () -> GoT m (Either NodeDeleteError ())
forall a b. (a -> b) -> a -> b
$ () -> Either NodeDeleteError ()
forall a b. b -> Either a b
Right ()
on :: Event (GoT m) h -> h -> GoT m ()
on Event (GoT m) h
event h
handler = (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall (m :: * -> *).
Monad m =>
(GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
modifyState ((GoState (GoT m) -> GoState (GoT m)) -> GoT m ())
-> (GoState (GoT m) -> GoState (GoT m)) -> GoT m ()
forall a b. (a -> b) -> a -> b
$ Event (GoT m) h -> h -> GoState (GoT m) -> GoState (GoT m)
forall (go :: * -> *) h.
Event go h -> h -> GoState go -> GoState go
addHandler Event (GoT m) h
event h
handler
goUp' :: Monad m => (PathStack -> PathStack) -> GoT m Bool
goUp' :: (PathStack -> PathStack) -> GoT m Bool
goUp' PathStack -> PathStack
pathStackFn = do
state :: GoState (GoT m)
state@(GoState { stateCursor :: forall (go :: * -> *). GoState go -> Cursor
stateCursor = Cursor
cursor
, statePathStack :: forall (go :: * -> *). GoState go -> PathStack
statePathStack = PathStack
pathStack
}) <- GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
case Cursor -> Maybe Cursor
cursorParent Cursor
cursor of
Maybe Cursor
Nothing -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Cursor
parent -> do
let index :: Int
index = Cursor -> Int
cursorChildIndex Cursor
cursor
GoState (GoT m) -> GoT m ()
forall (m :: * -> *). Monad m => GoState (GoT m) -> GoT m ()
putState GoState (GoT m)
state { stateCursor :: Cursor
stateCursor = Cursor
parent
, statePathStack :: PathStack
statePathStack = PathStack -> PathStack
pathStackFn PathStack
pathStack
}
Event (GoT m) (NavigationHandler (GoT m))
-> (NavigationHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (NavigationHandler (GoT m))
forall (go :: * -> *). Event go (NavigationHandler go)
navigationEvent (NavigationHandler (GoT m) -> NavigationHandler (GoT m)
forall a b. (a -> b) -> a -> b
$ Int -> Step
GoUp Int
index)
Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Property -> Bool) -> [Property] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((PropertyType
GameInfoProperty PropertyType -> PropertyType -> Bool
forall a. Eq a => a -> a -> Bool
==) (PropertyType -> Bool)
-> (Property -> PropertyType) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType) ([Property] -> Bool) -> [Property] -> Bool
forall a b. (a -> b) -> a -> b
$ Cursor -> [Property]
cursorProperties Cursor
cursor) (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$
Event (GoT m) (GameInfoChangedHandler (GoT m))
-> (GameInfoChangedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (GameInfoChangedHandler (GoT m))
forall (go :: * -> *). Event go (GameInfoChangedHandler go)
gameInfoChangedEvent (\GameInfoChangedHandler (GoT m)
f -> GameInfoChangedHandler (GoT m)
f (BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
cursor)
(BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
parent))
Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
goDown' :: Monad m => Int -> (PathStack -> PathStack) -> GoT m Bool
goDown' :: Int -> (PathStack -> PathStack) -> GoT m Bool
goDown' Int
index PathStack -> PathStack
pathStackFn = do
state :: GoState (GoT m)
state@(GoState { stateCursor :: forall (go :: * -> *). GoState go -> Cursor
stateCursor = Cursor
cursor
, statePathStack :: forall (go :: * -> *). GoState go -> PathStack
statePathStack = PathStack
pathStack
}) <- GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
case Int -> [Cursor] -> [Cursor]
forall a. Int -> [a] -> [a]
drop Int
index ([Cursor] -> [Cursor]) -> [Cursor] -> [Cursor]
forall a b. (a -> b) -> a -> b
$ Cursor -> [Cursor]
cursorChildren Cursor
cursor of
[] -> Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Cursor
child:[Cursor]
_ -> do
GoState (GoT m) -> GoT m ()
forall (m :: * -> *). Monad m => GoState (GoT m) -> GoT m ()
putState GoState (GoT m)
state { stateCursor :: Cursor
stateCursor = Cursor
child
, statePathStack :: PathStack
statePathStack = PathStack -> PathStack
pathStackFn PathStack
pathStack
}
Event (GoT m) (NavigationHandler (GoT m))
-> (NavigationHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (NavigationHandler (GoT m))
forall (go :: * -> *). Event go (NavigationHandler go)
navigationEvent (NavigationHandler (GoT m) -> NavigationHandler (GoT m)
forall a b. (a -> b) -> a -> b
$ Int -> Step
GoDown Int
index)
Bool -> GoT m () -> GoT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Property -> Bool) -> [Property] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((PropertyType
GameInfoProperty PropertyType -> PropertyType -> Bool
forall a. Eq a => a -> a -> Bool
==) (PropertyType -> Bool)
-> (Property -> PropertyType) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType) ([Property] -> Bool) -> [Property] -> Bool
forall a b. (a -> b) -> a -> b
$ Cursor -> [Property]
cursorProperties Cursor
child) (GoT m () -> GoT m ()) -> GoT m () -> GoT m ()
forall a b. (a -> b) -> a -> b
$
Event (GoT m) (GameInfoChangedHandler (GoT m))
-> (GameInfoChangedHandler (GoT m) -> GoT m ()) -> GoT m ()
forall (m :: * -> *) h.
Monad m =>
Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) (GameInfoChangedHandler (GoT m))
forall (go :: * -> *). Event go (GameInfoChangedHandler go)
gameInfoChangedEvent (\GameInfoChangedHandler (GoT m)
f -> GameInfoChangedHandler (GoT m)
f (BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
cursor)
(BoardState -> GameInfo
boardGameInfo (BoardState -> GameInfo) -> BoardState -> GameInfo
forall a b. (a -> b) -> a -> b
$ Cursor -> BoardState
cursorBoard Cursor
child))
Bool -> GoT m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
getPathStack :: Monad m => GoT m PathStack
getPathStack :: GoT m PathStack
getPathStack = (GoState (GoT m) -> PathStack)
-> GoT m (GoState (GoT m)) -> GoT m PathStack
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM GoState (GoT m) -> PathStack
forall (go :: * -> *). GoState go -> PathStack
statePathStack GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
doesPathStackEnterCurrentNode :: Cursor -> PathStack -> Bool
doesPathStackEnterCurrentNode :: Cursor -> PathStack -> Bool
doesPathStackEnterCurrentNode Cursor
cursor PathStack
pathStack =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [[Bool]] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Step -> Bool)
-> (Step -> Bool)
-> (Step -> Bool)
-> Cursor
-> PathStack
-> [[Bool]]
forall a.
(Step -> a)
-> (Step -> a) -> (Step -> a) -> Cursor -> PathStack -> [[a]]
foldPathStack (Bool -> Step -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> Step -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> Step -> Bool
forall a b. a -> b -> a
const Bool
False) Cursor
cursor PathStack
pathStack
foldPathStack :: (Step -> a)
-> (Step -> a)
-> (Step -> a)
-> Cursor
-> PathStack
-> [[a]]
foldPathStack :: (Step -> a)
-> (Step -> a) -> (Step -> a) -> Cursor -> PathStack -> [[a]]
foldPathStack Step -> a
_ Step -> a
_ Step -> a
_ Cursor
_ [] = []
foldPathStack Step -> a
onEnter Step -> a
onExit Step -> a
onOther Cursor
cursor0 PathStack
paths =
((Cursor, [Step]), [[a]]) -> [[a]]
forall a b. (a, b) -> b
snd (((Cursor, [Step]), [[a]]) -> [[a]])
-> ((Cursor, [Step]), [[a]]) -> [[a]]
forall a b. (a -> b) -> a -> b
$ ((Cursor, [Step]) -> [Step] -> ((Cursor, [Step]), [a]))
-> (Cursor, [Step]) -> PathStack -> ((Cursor, [Step]), [[a]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Cursor, [Step]) -> [Step] -> ((Cursor, [Step]), [a])
updatePath (Cursor
cursor0, []) PathStack
paths
where
updatePath :: (Cursor, [Step]) -> [Step] -> ((Cursor, [Step]), [a])
updatePath = ((Cursor, [Step]) -> Step -> ((Cursor, [Step]), a))
-> (Cursor, [Step]) -> [Step] -> ((Cursor, [Step]), [a])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (Cursor, [Step]) -> Step -> ((Cursor, [Step]), a)
updateStep
updateStep :: (Cursor, [Step]) -> Step -> ((Cursor, [Step]), a)
updateStep (Cursor
cursor, []) Step
step = ((Step -> Cursor -> Cursor
takeStep Step
step Cursor
cursor, [Step -> Step
reverseStep Step
step]), Step -> a
onExit Step
step)
updateStep (Cursor
cursor, pathToInitial :: [Step]
pathToInitial@(Step
stepToInitial:[Step]
restToInitial)) Step
step =
let pathToInitial' :: [Step]
pathToInitial' = if Step
stepToInitial Step -> Step -> Bool
forall a. Eq a => a -> a -> Bool
== Step
step
then [Step]
restToInitial
else Step -> Step
reverseStep Step
stepStep -> [Step] -> [Step]
forall a. a -> [a] -> [a]
:[Step]
pathToInitial
in ((Step -> Cursor -> Cursor
takeStep Step
step Cursor
cursor, [Step]
pathToInitial'),
if [Step] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Step]
pathToInitial' then Step -> a
onEnter Step
step else Step -> a
onOther Step
step)
fire :: Monad m => Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire :: Event (GoT m) h -> (h -> GoT m ()) -> GoT m ()
fire Event (GoT m) h
event h -> GoT m ()
handlerGenerator = do
GoState (GoT m)
state <- GoT m (GoState (GoT m))
forall (m :: * -> *). Monad m => GoT m (GoState (GoT m))
getState
(h -> GoT m ()) -> [h] -> GoT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ h -> GoT m ()
handlerGenerator ([h] -> GoT m ()) -> [h] -> GoT m ()
forall a b. (a -> b) -> a -> b
$ Event (GoT m) h -> GoState (GoT m) -> [h]
forall (go :: * -> *) h. Event go h -> GoState go -> [h]
eventStateGetter Event (GoT m) h
event GoState (GoT m)
state
data Event go h = Event
{ Event go h -> String
eventName :: String
, Event go h -> GoState go -> [h]
eventStateGetter :: GoState go -> [h]
, Event go h -> [h] -> GoState go -> GoState go
eventStateSetter :: [h] -> GoState go -> GoState go
, Event go h -> go () -> h
eventHandlerFromAction :: go () -> h
}
instance Eq (Event go h) where
== :: Event go h -> Event go h -> Bool
(==) = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (Event go h -> String) -> Event go h -> Event go h -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`F.on` Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName
instance Ord (Event go h) where
compare :: Event go h -> Event go h -> Ordering
compare = (Event go h -> String) -> Event go h -> Event go h -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName
instance Show (Event go h) where
show :: Event go h -> String
show = Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName
data AnyEvent go = forall h. AnyEvent (Event go h)
instance Eq (AnyEvent go) where
(AnyEvent Event go h
e) == :: AnyEvent go -> AnyEvent go -> Bool
== (AnyEvent Event go h
e') = Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName Event go h
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName Event go h
e'
instance Ord (AnyEvent go) where
compare :: AnyEvent go -> AnyEvent go -> Ordering
compare (AnyEvent Event go h
e) (AnyEvent Event go h
e') = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName Event go h
e) (Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName Event go h
e')
instance Show (AnyEvent go) where
show :: AnyEvent go -> String
show (AnyEvent Event go h
e) = Event go h -> String
forall (go :: * -> *) h. Event go h -> String
eventName Event go h
e
addHandler :: Event go h -> h -> GoState go -> GoState go
addHandler :: Event go h -> h -> GoState go -> GoState go
addHandler Event go h
event h
handler GoState go
state =
Event go h -> [h] -> GoState go -> GoState go
forall (go :: * -> *) h.
Event go h -> [h] -> GoState go -> GoState go
eventStateSetter Event go h
event (Event go h -> GoState go -> [h]
forall (go :: * -> *) h. Event go h -> GoState go -> [h]
eventStateGetter Event go h
event GoState go
state [h] -> [h] -> [h]
forall a. [a] -> [a] -> [a]
++ [h
handler]) GoState go
state
childAddedEvent :: Event go (ChildAddedHandler go)
childAddedEvent :: Event go (ChildAddedHandler go)
childAddedEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"childAddedEvent"
, eventStateGetter :: GoState go -> [ChildAddedHandler go]
eventStateGetter = GoState go -> [ChildAddedHandler go]
forall (go :: * -> *). GoState go -> [ChildAddedHandler go]
stateChildAddedHandlers
, eventStateSetter :: [ChildAddedHandler go] -> GoState go -> GoState go
eventStateSetter = \[ChildAddedHandler go]
handlers GoState go
state -> GoState go
state { stateChildAddedHandlers :: [ChildAddedHandler go]
stateChildAddedHandlers = [ChildAddedHandler go]
handlers }
, eventHandlerFromAction :: go () -> ChildAddedHandler go
eventHandlerFromAction = go () -> ChildAddedHandler go
forall a b. a -> b -> a
const
}
type ChildAddedHandler go = Int -> go ()
childDeletedEvent :: Event go (ChildDeletedHandler go)
childDeletedEvent :: Event go (ChildDeletedHandler go)
childDeletedEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"childDeletedEvent"
, eventStateGetter :: GoState go -> [ChildDeletedHandler go]
eventStateGetter = GoState go -> [ChildDeletedHandler go]
forall (go :: * -> *). GoState go -> [ChildDeletedHandler go]
stateChildDeletedHandlers
, eventStateSetter :: [ChildDeletedHandler go] -> GoState go -> GoState go
eventStateSetter = \[ChildDeletedHandler go]
handlers GoState go
state -> GoState go
state { stateChildDeletedHandlers :: [ChildDeletedHandler go]
stateChildDeletedHandlers = [ChildDeletedHandler go]
handlers }
, eventHandlerFromAction :: go () -> ChildDeletedHandler go
eventHandlerFromAction = go () -> ChildDeletedHandler go
forall a b. a -> b -> a
const
}
type ChildDeletedHandler go = Cursor -> go ()
gameInfoChangedEvent :: Event go (GameInfoChangedHandler go)
gameInfoChangedEvent :: Event go (GameInfoChangedHandler go)
gameInfoChangedEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"gameInfoChangedEvent"
, eventStateGetter :: GoState go -> [GameInfoChangedHandler go]
eventStateGetter = GoState go -> [GameInfoChangedHandler go]
forall (go :: * -> *). GoState go -> [GameInfoChangedHandler go]
stateGameInfoChangedHandlers
, eventStateSetter :: [GameInfoChangedHandler go] -> GoState go -> GoState go
eventStateSetter = \[GameInfoChangedHandler go]
handlers GoState go
state -> GoState go
state { stateGameInfoChangedHandlers :: [GameInfoChangedHandler go]
stateGameInfoChangedHandlers = [GameInfoChangedHandler go]
handlers }
, eventHandlerFromAction :: go () -> GameInfoChangedHandler go
eventHandlerFromAction = (GameInfo -> go ()) -> GameInfoChangedHandler go
forall a b. a -> b -> a
const ((GameInfo -> go ()) -> GameInfoChangedHandler go)
-> (go () -> GameInfo -> go ())
-> go ()
-> GameInfoChangedHandler go
forall b c a. (b -> c) -> (a -> b) -> a -> c
. go () -> GameInfo -> go ()
forall a b. a -> b -> a
const
}
type GameInfoChangedHandler go = GameInfo -> GameInfo -> go ()
navigationEvent :: Event go (NavigationHandler go)
navigationEvent :: Event go (NavigationHandler go)
navigationEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"navigationEvent"
, eventStateGetter :: GoState go -> [NavigationHandler go]
eventStateGetter = GoState go -> [NavigationHandler go]
forall (go :: * -> *). GoState go -> [NavigationHandler go]
stateNavigationHandlers
, eventStateSetter :: [NavigationHandler go] -> GoState go -> GoState go
eventStateSetter = \[NavigationHandler go]
handlers GoState go
state -> GoState go
state { stateNavigationHandlers :: [NavigationHandler go]
stateNavigationHandlers = [NavigationHandler go]
handlers }
, eventHandlerFromAction :: go () -> NavigationHandler go
eventHandlerFromAction = go () -> NavigationHandler go
forall a b. a -> b -> a
const
}
type NavigationHandler go = Step -> go ()
propertiesModifiedEvent :: Event go (PropertiesModifiedHandler go)
propertiesModifiedEvent :: Event go (PropertiesModifiedHandler go)
propertiesModifiedEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"propertiesModifiedEvent"
, eventStateGetter :: GoState go -> [PropertiesModifiedHandler go]
eventStateGetter = GoState go -> [PropertiesModifiedHandler go]
forall (go :: * -> *). GoState go -> [PropertiesModifiedHandler go]
statePropertiesModifiedHandlers
, eventStateSetter :: [PropertiesModifiedHandler go] -> GoState go -> GoState go
eventStateSetter = \[PropertiesModifiedHandler go]
handlers GoState go
state -> GoState go
state { statePropertiesModifiedHandlers :: [PropertiesModifiedHandler go]
statePropertiesModifiedHandlers = [PropertiesModifiedHandler go]
handlers }
, eventHandlerFromAction :: go () -> PropertiesModifiedHandler go
eventHandlerFromAction = ([Property] -> go ()) -> PropertiesModifiedHandler go
forall a b. a -> b -> a
const (([Property] -> go ()) -> PropertiesModifiedHandler go)
-> (go () -> [Property] -> go ())
-> go ()
-> PropertiesModifiedHandler go
forall b c a. (b -> c) -> (a -> b) -> a -> c
. go () -> [Property] -> go ()
forall a b. a -> b -> a
const
}
type PropertiesModifiedHandler go = [Property] -> [Property] -> go ()
variationModeChangedEvent :: Event go (VariationModeChangedHandler go)
variationModeChangedEvent :: Event go (VariationModeChangedHandler go)
variationModeChangedEvent = Event :: forall (go :: * -> *) h.
String
-> (GoState go -> [h])
-> ([h] -> GoState go -> GoState go)
-> (go () -> h)
-> Event go h
Event
{ eventName :: String
eventName = String
"variationModeChangedEvent"
, eventStateGetter :: GoState go -> [VariationModeChangedHandler go]
eventStateGetter = GoState go -> [VariationModeChangedHandler go]
forall (go :: * -> *).
GoState go -> [VariationModeChangedHandler go]
stateVariationModeChangedHandlers
, eventStateSetter :: [VariationModeChangedHandler go] -> GoState go -> GoState go
eventStateSetter = \[VariationModeChangedHandler go]
handlers GoState go
state -> GoState go
state { stateVariationModeChangedHandlers :: [VariationModeChangedHandler go]
stateVariationModeChangedHandlers = [VariationModeChangedHandler go]
handlers }
, eventHandlerFromAction :: go () -> VariationModeChangedHandler go
eventHandlerFromAction = (VariationMode -> go ()) -> VariationModeChangedHandler go
forall a b. a -> b -> a
const ((VariationMode -> go ()) -> VariationModeChangedHandler go)
-> (go () -> VariationMode -> go ())
-> go ()
-> VariationModeChangedHandler go
forall b c a. (b -> c) -> (a -> b) -> a -> c
. go () -> VariationMode -> go ()
forall a b. a -> b -> a
const
}
type VariationModeChangedHandler go = VariationMode -> VariationMode -> go ()