goatee-0.4.0: A monadic take on a 2,500-year-old board game - library.
Safe HaskellNone
LanguageHaskell2010

Game.Goatee.Lib.Monad

Description

A monad for working with game trees.

Synopsis

The Go monad

class (Functor go, Applicative go, Monad go) => MonadGo go where Source #

A monad (transformer) for navigating and mutating Cursors, and remembering previous locations. See GoT and GoM.

The monad supports handlers for events raised during actions it takes, such as navigating through the tree and modifying nodes.

Methods

getCursor :: go Cursor Source #

Returns the current cursor.

getCoordState :: Coord -> go CoordState Source #

Returns the CoordState at the given point.

goUp :: go Bool Source #

Navigates up to the parent node, fires a navigationEvent, then returns true. If already at the root of the tree, then none of this happens and false is returned.

goDown :: Int -> go Bool Source #

Navigates down the tree to the child with the given index, fires a navigationEvent, then returns true. If the requested child doesn't exist, then none of this happens and false is returned.

goLeft :: go Bool Source #

If possible, moves to the sibling node immediately to the left of the current one. Returns whether a move was made (i.e. whether there was a left sibling). Fires navigationEvents while moving.

goRight :: go Bool Source #

If possible, moves to the sibling node immediately to the right of the current one. Returns whether a move was made (i.e. whether there was a right sibling). Fires navigationEvents while moving.

goToRoot :: go () Source #

Navigates up to the root of the tree. Fires navigationEvents for each step.

goToGameInfoNode Source #

Arguments

:: Bool

When no node with game info is found, then if false, return to the original node, otherwise finish at the root node.

-> go Bool 

Navigates up the tree to the node containing game info properties, if any. Returns true if a game info node was found.

pushPosition :: go () Source #

Pushes the current location in the game tree onto an internal position stack, such that popPosition is capable of navigating back to the same position, even if the game tree has been modified (though the old position must still exist in the tree to return to it).

popPosition :: go (Either PopPositionError ()) Source #

Returns to the last position pushed onto the internal position stack via pushPosition, if there is one. Returns a code indicating the result of the action.

dropPosition :: go (Either DropPositionError ()) Source #

Drops the last position pushed onto the internal stack by pushPosition off of the stack, if there is one. Returns a code indicating the result of the action.

getProperties :: go [Property] Source #

Returns the set of properties on the current node.

modifyProperties :: ([Property] -> [Property]) -> go () Source #

Modifies the set of properties on the current node. Fires propertiesModifiedEvent after modifying if the new property set is different from the old property set (order is irrelevant).

getProperty :: Descriptor d => d -> go (Maybe Property) Source #

Searches for a property on the current node, returning it if found.

getPropertyValue :: ValuedDescriptor v d => d -> go (Maybe v) Source #

Searches for a valued property on the current node, returning its value if found.

putProperty :: Property -> go () Source #

Sets a property on the current node, replacing an existing property with the same name, if one exists. Fires propertiesModifiedEvent if the property has changed.

deleteProperty :: Descriptor d => d -> go () Source #

Deletes a property from the current node, if it's set, and fires propertiesModifiedEvent.

Note that although a Property is a Descriptor, giving a valued Property here will not cause deletion to match on the value of the property. That is, the following code will result in Nothing, because the deletion only cares about the name of the property.

do putProperty $ PL Black
   deleteProperty $ PL White
   getPropertyValue propertyPL

modifyProperty :: Descriptor d => d -> (Maybe Property -> Maybe Property) -> go (Either ModifyPropertyError ()) Source #

Calls the given function to modify the state of the given property (descriptor) on the current node. Nothing represents the property not existing on the node, and a Just marks the property's presence. Fires propertiesModifiedEvent if the property changed. This function does not do any validation to check that the resulting tree state is valid.

The given function is not allowed to change the property into a different property. Instead, the old property should be removed and the new property should be inserted separately. If the function does this, ModifyPropertyCannotChangeType is returned and no modification takes place.

modifyPropertyValue :: ValuedDescriptor v d => d -> (Maybe v -> Maybe v) -> go () Source #

Calls the given function to modify the state of the given valued property (descriptor) on the current node. Nothing represents the property not existing on the node, and a Just with the property's value marks the property's presence. Fires propertiesModifiedEvent if the property changed. This function does not do any validation to check that the resulting tree state is valid.

modifyPropertyString :: (Stringlike s, ValuedDescriptor s d) => d -> (String -> String) -> go () Source #

Mutates the string-valued property attached to the current node according to the given function. The input string will be empty if the current node either has the property with an empty value, or doesn't have the property. Returning an empty string removes the property from the node, if it was set. Fires propertiesModifiedEvent if the property changed.

modifyPropertyList :: ValuedDescriptor [v] d => d -> ([v] -> [v]) -> go () Source #

Mutates the list-valued property attached to the current node according to the given function. The input list will be empty if the current node either has the property with an empty value, or doesn't have the property. Returning an empty list removes the property from the node, if it was set.

Fires propertiesModifiedEvent if the property changed.

See also modifyPropertyCoords.

modifyPropertyCoords :: ValuedDescriptor CoordList d => d -> ([Coord] -> [Coord]) -> go () Source #

Mutates the CoordList-valued property attached to the current node according to the given function. Conversion between CoordList and [Coord] is performed automatically. The input list will be empty if the current node either has the property with an empty value, or doesn't have the property. Returning an empty list removes the property from the node, if it was set.

Importantly, this might not be specific enough for properties such as DD and VW where a present, empty list has different semantics from the property not being present. In that case, modifyPropertyValue is better.

Fires propertiesModifiedEvent if the property changed.

modifyGameInfo :: (GameInfo -> GameInfo) -> go (Either ModifyGameInfoError (GameInfo, GameInfo)) Source #

Mutates the game info for the current path, returning the new info. If the current node or one of its ancestors has game info properties, then that node is modified. Otherwise, properties are inserted on the root node. The return value on success is (oldGameInfo, newGameInfo).

The given function is not allowed to modify the RootInfo within the GameInfo. If this happens, an error code is returned and no modifications are made.

modifyVariationMode :: (VariationMode -> VariationMode) -> go () Source #

Sets the game's VariationMode via the ST property on the root node, then fires a variationModeChangedEvent if the variation mode has changed.

getAssignedStone :: Coord -> go (Maybe (Maybe Color)) Source #

Retrieves the stone assigned in the current node to a point by AB, AE, or AW. The possible results are:

  • Nothing: No stone has been assigned to the point. The point could still be in any state, e.g. from a play on the current node or some property in an ancestor node.
  • Just Nothing: The point has been assigned to be empty.
  • Just (Just Color): The point has been assigned to have a stone of the given color.

getAllAssignedStones :: go (Map Coord (Maybe Color)) Source #

Looks up all stones that are assigned by AB, AE, or AW properties on the current node. Returns a map from each point to the stone that is assigned to the point.

modifyAssignedStones :: [Coord] -> (Maybe (Maybe Color) -> Maybe (Maybe Color)) -> go () Source #

Modifies the state of currently assigned stones, keeping in mind that it is invalid to mix MoveProperty and SetupProperty properties in a single node. This function has the behaviour of a user changing stone assignments in a UI. How this function works is:

  • Pick a node to work with. If there is a move property on the current node and there is not already a setup property on the current node, then we'll create and modify a new child node. Otherwise, either there are no move properties on the node (so we can add setup properties at will), or there are both move and setup properties on the node (the node is already invalid), so we'll just modify the current node.
  • If we're modifying the current node, then apply the modification function to the state of stone assignment for each coordinate. See getAssignedStone for the meaning of Maybe (Maybe Color). Modify the properties in the node as necessary to apply the result (propertiesModifiedEvent). (NOTE: Currently one event is fired for each property modified; this may change in the future.)
  • If we need to create a child node, then apply the modification function to Nothing to determine if we're actually adding assignments. If the function returns a Just, then we create a child node with the necessary assignment properties, insert it (childAddedEvent), then navigate to it (navigationEvent). If the function returns Nothing, then modifyAssignedStones does nothing.

getMark :: Coord -> go (Maybe Mark) Source #

Returns the Mark at a point on the current node.

modifyMark :: (Maybe Mark -> Maybe Mark) -> Coord -> go () Source #

Calls the given function to modify the presence of a Mark on the current node.

addChild :: Node -> go () Source #

Adds a child node to the current node at the end of the current node's child list. Fires a childAddedEvent after the child is added.

addChildAt :: Int -> Node -> go () Source #

Adds a child node to the current node at the given index, shifting all existing children at and after the index to the right. The index must be in the range [0, numberOfChildren]; if it is not, it will be capped to this range. Fires a childAddedEvent after the child is added.

deleteChildAt :: Int -> go (Either NodeDeleteError ()) Source #

Tries to remove the child node at the given index below the current node. Returns a status code indicating whether the deletion succeeded, or why not.

on :: Event go h -> h -> go () Source #

Registers a new event handler for a given event type.

on0 :: Event go h -> go () -> go () Source #

Registers a new event handler for a given event type. Unlike on, whose handler may receive arguments, the handler given here doesn't receive any arguments.

Instances

Instances details
Monad m => MonadGo (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

getCursor :: GoT m Cursor Source #

getCoordState :: Coord -> GoT m CoordState Source #

goUp :: GoT m Bool Source #

goDown :: Int -> GoT m Bool Source #

goLeft :: GoT m Bool Source #

goRight :: GoT m Bool Source #

goToRoot :: GoT m () Source #

goToGameInfoNode :: Bool -> GoT m Bool Source #

pushPosition :: GoT m () Source #

popPosition :: GoT m (Either PopPositionError ()) Source #

dropPosition :: GoT m (Either DropPositionError ()) Source #

getProperties :: GoT m [Property] Source #

modifyProperties :: ([Property] -> [Property]) -> GoT m () Source #

getProperty :: Descriptor d => d -> GoT m (Maybe Property) Source #

getPropertyValue :: ValuedDescriptor v d => d -> GoT m (Maybe v) Source #

putProperty :: Property -> GoT m () Source #

deleteProperty :: Descriptor d => d -> GoT m () Source #

modifyProperty :: Descriptor d => d -> (Maybe Property -> Maybe Property) -> GoT m (Either ModifyPropertyError ()) Source #

modifyPropertyValue :: ValuedDescriptor v d => d -> (Maybe v -> Maybe v) -> GoT m () Source #

modifyPropertyString :: (Stringlike s, ValuedDescriptor s d) => d -> (String -> String) -> GoT m () Source #

modifyPropertyList :: ValuedDescriptor [v] d => d -> ([v] -> [v]) -> GoT m () Source #

modifyPropertyCoords :: ValuedDescriptor CoordList d => d -> ([Coord] -> [Coord]) -> GoT m () Source #

modifyGameInfo :: (GameInfo -> GameInfo) -> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo)) Source #

modifyVariationMode :: (VariationMode -> VariationMode) -> GoT m () Source #

getAssignedStone :: Coord -> GoT m (Maybe (Maybe Color)) Source #

getAllAssignedStones :: GoT m (Map Coord (Maybe Color)) Source #

modifyAssignedStones :: [Coord] -> (Maybe (Maybe Color) -> Maybe (Maybe Color)) -> GoT m () Source #

getMark :: Coord -> GoT m (Maybe Mark) Source #

modifyMark :: (Maybe Mark -> Maybe Mark) -> Coord -> GoT m () Source #

addChild :: Node -> GoT m () Source #

addChildAt :: Int -> Node -> GoT m () Source #

deleteChildAt :: Int -> GoT m (Either NodeDeleteError ()) Source #

on :: Event (GoT m) h -> h -> GoT m () Source #

on0 :: Event (GoT m) h -> GoT m () -> GoT m () Source #

data GoT m a Source #

The standard monad transformer for MonadGo.

Instances

Instances details
MonadTrans GoT Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

lift :: Monad m => m a -> GoT m a #

MonadWriter w m => MonadWriter w (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

writer :: (a, w) -> GoT m a #

tell :: w -> GoT m () #

listen :: GoT m a -> GoT m (a, w) #

pass :: GoT m (a, w -> w) -> GoT m a #

MonadState s m => MonadState s (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

get :: GoT m s #

put :: s -> GoT m () #

state :: (s -> (a, s)) -> GoT m a #

MonadError e m => MonadError e (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

throwError :: e -> GoT m a #

catchError :: GoT m a -> (e -> GoT m a) -> GoT m a #

Monad m => Monad (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

(>>=) :: GoT m a -> (a -> GoT m b) -> GoT m b #

(>>) :: GoT m a -> GoT m b -> GoT m b #

return :: a -> GoT m a #

Monad m => Functor (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

fmap :: (a -> b) -> GoT m a -> GoT m b #

(<$) :: a -> GoT m b -> GoT m a #

MonadFail m => MonadFail (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

fail :: String -> GoT m a #

Monad m => Applicative (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

pure :: a -> GoT m a #

(<*>) :: GoT m (a -> b) -> GoT m a -> GoT m b #

liftA2 :: (a -> b -> c) -> GoT m a -> GoT m b -> GoT m c #

(*>) :: GoT m a -> GoT m b -> GoT m b #

(<*) :: GoT m a -> GoT m b -> GoT m a #

MonadIO m => MonadIO (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

liftIO :: IO a -> GoT m a #

Monad m => MonadGo (GoT m) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

getCursor :: GoT m Cursor Source #

getCoordState :: Coord -> GoT m CoordState Source #

goUp :: GoT m Bool Source #

goDown :: Int -> GoT m Bool Source #

goLeft :: GoT m Bool Source #

goRight :: GoT m Bool Source #

goToRoot :: GoT m () Source #

goToGameInfoNode :: Bool -> GoT m Bool Source #

pushPosition :: GoT m () Source #

popPosition :: GoT m (Either PopPositionError ()) Source #

dropPosition :: GoT m (Either DropPositionError ()) Source #

getProperties :: GoT m [Property] Source #

modifyProperties :: ([Property] -> [Property]) -> GoT m () Source #

getProperty :: Descriptor d => d -> GoT m (Maybe Property) Source #

getPropertyValue :: ValuedDescriptor v d => d -> GoT m (Maybe v) Source #

putProperty :: Property -> GoT m () Source #

deleteProperty :: Descriptor d => d -> GoT m () Source #

modifyProperty :: Descriptor d => d -> (Maybe Property -> Maybe Property) -> GoT m (Either ModifyPropertyError ()) Source #

modifyPropertyValue :: ValuedDescriptor v d => d -> (Maybe v -> Maybe v) -> GoT m () Source #

modifyPropertyString :: (Stringlike s, ValuedDescriptor s d) => d -> (String -> String) -> GoT m () Source #

modifyPropertyList :: ValuedDescriptor [v] d => d -> ([v] -> [v]) -> GoT m () Source #

modifyPropertyCoords :: ValuedDescriptor CoordList d => d -> ([Coord] -> [Coord]) -> GoT m () Source #

modifyGameInfo :: (GameInfo -> GameInfo) -> GoT m (Either ModifyGameInfoError (GameInfo, GameInfo)) Source #

modifyVariationMode :: (VariationMode -> VariationMode) -> GoT m () Source #

getAssignedStone :: Coord -> GoT m (Maybe (Maybe Color)) Source #

getAllAssignedStones :: GoT m (Map Coord (Maybe Color)) Source #

modifyAssignedStones :: [Coord] -> (Maybe (Maybe Color) -> Maybe (Maybe Color)) -> GoT m () Source #

getMark :: Coord -> GoT m (Maybe Mark) Source #

modifyMark :: (Maybe Mark -> Maybe Mark) -> Coord -> GoT m () Source #

addChild :: Node -> GoT m () Source #

addChildAt :: Int -> Node -> GoT m () Source #

deleteChildAt :: Int -> GoT m (Either NodeDeleteError ()) Source #

on :: Event (GoT m) h -> h -> GoT m () Source #

on0 :: Event (GoT m) h -> GoT m () -> GoT m () Source #

type GoM = GoT Identity Source #

The standard monad for MonadGo.

runGoT :: Monad m => GoT m a -> Cursor -> m (a, Cursor) Source #

Executes a Go monad transformer on a cursor, returning in the underlying monad a tuple that contains the resulting value and the final cursor.

runGo :: GoM a -> Cursor -> (a, Cursor) Source #

Runs a Go monad on a cursor. See runGoT.

evalGoT :: Monad m => GoT m a -> Cursor -> m a Source #

Executes a Go monad transformer on a cursor, returning in the underlying monad the value in the transformer.

evalGo :: GoM a -> Cursor -> a Source #

Runs a Go monad on a cursor and returns the value in the monad.

execGoT :: Monad m => GoT m a -> Cursor -> m Cursor Source #

Executes a Go monad transformer on a cursor, returning in the underlying monad the final cursor.

execGo :: GoM a -> Cursor -> Cursor Source #

Runs a Go monad on a cursor and returns the final cursor.

data Step Source #

A single step along a game tree. Either up or down.

Constructors

GoUp Int

Represents a step up from a child with the given index.

GoDown Int

Represents a step down to the child with the given index.

Instances

Instances details
Eq Step Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

(==) :: Step -> Step -> Bool #

(/=) :: Step -> Step -> Bool #

Show Step Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

showsPrec :: Int -> Step -> ShowS #

show :: Step -> String #

showList :: [Step] -> ShowS #

Errors

data NavigationError Source #

Errors from attempting to navigate. Thrown by goUpOrThrow, goDownOrThrow, goLeftOrThrow, goRightOrThrow.

Constructors

NavigationCouldNotMove

Could not make the requested motion.

data PopPositionError Source #

Errors from popPosition.

Constructors

PopPositionStackEmpty

There is no previous position to return to. No action was taken.

PopPositionCannotRetraceSteps

The previous position could not be returned to, because the game tree has been modified. The current position in the game tree is where motion reached when it could go no further. This is probably not useful, and computation should be abandoned.

data DropPositionError Source #

Errors from dropPosition.

Constructors

DropPositionStackEmpty

There is no previous position to drop. No action was taken.

data ModifyPropertyError Source #

Errors from modifyProperty.

Constructors

ModifyPropertyCannotChangeType String String

The function attempted to change the property into another property; this is not allowed. No change was made. The two strings are renderings of the old and new property, respectively.

data ModifyGameInfoError Source #

Errors from modifyGameInfo.

Constructors

ModifyGameInfoCannotModifyRootInfo GameInfo GameInfo

The function illegally attempted to modify RootInfo properties within the GameInfo. The old and attempted new records are returned, respectfully. No changes were committed to the game info.

data NodeDeleteError Source #

Errors from calling deleteChildAt.

Constructors

NodeDeleteBadIndex

The node couldn't be deleted, because an invalid index was given.

NodeDeleteOnPathStack

The node couldn't be deleted, because it is on the path stack.

Throwing monadic actions

goUpOrThrow :: (MonadGo m, MonadError GoError m) => m () Source #

Like goUp, but throws NavigationCouldNotMove if at the root of the tree.

goDownOrThrow :: (MonadGo m, MonadError GoError m) => Int -> m () Source #

Like goDown, but throws NavigationCouldNotMove if the requested child does not exist.

goLeftOrThrow :: (MonadGo m, MonadError GoError m) => m () Source #

Like goLeft, but throws NavigationCouldNotMove if there is no left sibling to move to.

goRightOrThrow :: (MonadGo m, MonadError GoError m) => m () Source #

Like goRight, but throws NavigationCouldNotMove if there is no right sibling to move to.

popPositionOrThrow :: (MonadGo m, MonadError GoError m) => m () Source #

Same as popPosition, but throws errors rather than returning them.

dropPositionOrThrow :: (MonadGo m, MonadError GoError m) => m () Source #

Same as dropPosition, but throws errors rather than returning them.

modifyPropertyOrThrow :: (MonadGo m, MonadError GoError m, Descriptor d) => d -> (Maybe Property -> Maybe Property) -> m () Source #

Same as modifyProperty, but throws errors rather than returning them.

modifyGameInfoOrThrow :: (MonadGo m, MonadError GoError m) => (GameInfo -> GameInfo) -> m (GameInfo, GameInfo) Source #

Same as modifyGameInfo, but throws errors rather than returning them.

deleteChildAtOrThrow :: (MonadGo m, MonadError GoError m) => Int -> m () Source #

Same as deleteChildAt, but throws errors rather than returning them.

Event handling

data Event go h Source #

A type of event in a Go monad that can be handled by executing an action. go is the type of the Go monad. h is the handler type, a function that takes some arguments relating to the event and returns an action in the Go monad. The arguments to the handler are usually things that would be difficult to recover from the state of the monad alone, for example the Step associated with a navigationEvent.

The Eq, Ord, and Show instances use events' names, via eventName.

Instances

Instances details
Eq (Event go h) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

(==) :: Event go h -> Event go h -> Bool #

(/=) :: Event go h -> Event go h -> Bool #

Ord (Event go h) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

compare :: Event go h -> Event go h -> Ordering #

(<) :: Event go h -> Event go h -> Bool #

(<=) :: Event go h -> Event go h -> Bool #

(>) :: Event go h -> Event go h -> Bool #

(>=) :: Event go h -> Event go h -> Bool #

max :: Event go h -> Event go h -> Event go h #

min :: Event go h -> Event go h -> Event go h #

Show (Event go h) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

showsPrec :: Int -> Event go h -> ShowS #

show :: Event go h -> String #

showList :: [Event go h] -> ShowS #

data AnyEvent go Source #

An existential type for any event in a particular Go monad. Like Event, the Eq, Ord, and Show instances use events' names, via eventName.

Constructors

forall h. AnyEvent (Event go h) 

Instances

Instances details
Eq (AnyEvent go) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

(==) :: AnyEvent go -> AnyEvent go -> Bool #

(/=) :: AnyEvent go -> AnyEvent go -> Bool #

Ord (AnyEvent go) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

compare :: AnyEvent go -> AnyEvent go -> Ordering #

(<) :: AnyEvent go -> AnyEvent go -> Bool #

(<=) :: AnyEvent go -> AnyEvent go -> Bool #

(>) :: AnyEvent go -> AnyEvent go -> Bool #

(>=) :: AnyEvent go -> AnyEvent go -> Bool #

max :: AnyEvent go -> AnyEvent go -> AnyEvent go #

min :: AnyEvent go -> AnyEvent go -> AnyEvent go #

Show (AnyEvent go) Source # 
Instance details

Defined in Game.Goatee.Lib.Monad

Methods

showsPrec :: Int -> AnyEvent go -> ShowS #

show :: AnyEvent go -> String #

showList :: [AnyEvent go] -> ShowS #

fire :: Monad m => Event (GoT m) h -> (h -> GoT m ()) -> GoT m () Source #

Fires all of the handlers for the given event, using the given function to create a Go action from each of the handlers (normally themselves functions that create Go actions, if they're not just Go actions directly, depending on the event).

eventHandlerFromAction :: Event go h -> go () -> h Source #

Events

childAddedEvent :: Event go (ChildAddedHandler go) Source #

An event corresponding to a child node being added to the current node.

type ChildAddedHandler go = Int -> go () Source #

A handler for childAddedEvents. Called with the index of the child added to the current node.

childDeletedEvent :: Event go (ChildDeletedHandler go) Source #

An event corresponding to the deletion of one of the current node's children.

type ChildDeletedHandler go = Cursor -> go () Source #

A handler for childDeletedEvents. It is called with a cursor at the child that was deleted (this cursor is now out of date).

gameInfoChangedEvent :: Event go (GameInfoChangedHandler go) Source #

An event that is fired when the current game info changes, either by navigating past a node with game info properties, or by modifying the current game info properties.

type GameInfoChangedHandler go = GameInfo -> GameInfo -> go () Source #

A handler for gameInfoChangedEvents. It is called with the old game info then the new game info.

navigationEvent :: Event go (NavigationHandler go) Source #

An event that is fired when a single step up or down in a game tree is made.

type NavigationHandler go = Step -> go () Source #

A handler for navigationEvents.

A navigation handler may navigate further, but beware infinite recursion. A navigation handler must end on the same node on which it started.

propertiesModifiedEvent :: Event go (PropertiesModifiedHandler go) Source #

An event corresponding to a modification to the properties list of the current node.

type PropertiesModifiedHandler go = [Property] -> [Property] -> go () Source #

A handler for propertiesModifiedEvents. It is called with the old property list then the new property list.

variationModeChangedEvent :: Event go (VariationModeChangedHandler go) Source #

An event corresponding to a change in the active VariationMode. This can happen when modifying the ST property, and also when navigating between collections (as they have different root nodes).

type VariationModeChangedHandler go = VariationMode -> VariationMode -> go () Source #

A handler for variationModeChangedEvents. It is called with the old variation mode then the new variation mode.