{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Graphs.EmptyGraphSort(
emptyGraphSort,
) where
import Data.IORef
import Util.Dynamics
import Util.Delayer
import Util.Computation
import Util.Object
import Util.ExtendedPrelude
import Util.VariableList
import Events.Events
import Events.Destructible
import Events.Channels
import Graphs.GraphDisp hiding (redraw)
import Graphs.GraphConfigure
data EmptyGraph = EmptyGraph {
EmptyGraph -> Delayer
delayer :: Delayer,
EmptyGraph -> Channel ()
destructChan :: Channel (),
EmptyGraph -> ObjectID
oId :: ObjectID
} deriving (Typeable)
data EmptyGraphParms = EmptyGraphParms
data EmptyNode value = EmptyNode {
EmptyNode value -> IORef value
ioRefN :: IORef value,
EmptyNode value -> ObjectID
oIdN :: ObjectID
} deriving (Typeable)
data EmptyNodeType value = EmptyNodeType deriving (Typeable)
data EmptyNodeTypeParms value = EmptyNodeTypeParms
data EmptyArc value = EmptyArc {
EmptyArc value -> IORef (Maybe value)
ioRefE :: IORef (Maybe value),
EmptyArc value -> ObjectID
oIdE :: ObjectID
} deriving (Typeable)
newtype EmptyArcType value = EmptyArcType {EmptyArcType value -> ObjectID
oIdET :: ObjectID}
deriving (Typeable)
data EmptyArcTypeParms value = EmptyArcTypeParms
emptyGraphSort :: Graph EmptyGraph
EmptyGraphParms EmptyNode EmptyNodeType EmptyNodeTypeParms
EmptyArc EmptyArcType EmptyArcTypeParms
emptyGraphSort :: Graph
EmptyGraph
EmptyGraphParms
EmptyNode
EmptyNodeType
EmptyNodeTypeParms
EmptyArc
EmptyArcType
EmptyArcTypeParms
emptyGraphSort = Graph
EmptyGraph
EmptyGraphParms
EmptyNode
EmptyNodeType
EmptyNodeTypeParms
EmptyArc
EmptyArcType
EmptyArcTypeParms
forall graph graphParms (node :: * -> *) (nodeType :: * -> *)
(nodeTypeParms :: * -> *) (arc :: * -> *) (arcType :: * -> *)
(arcTypeParms :: * -> *).
GraphAll
graph
graphParms
node
nodeType
nodeTypeParms
arc
arcType
arcTypeParms =>
Graph
graph
graphParms
node
nodeType
nodeTypeParms
arc
arcType
arcTypeParms
displaySort
instance GraphAllConfig EmptyGraph EmptyGraphParms
EmptyNode EmptyNodeType EmptyNodeTypeParms
EmptyArc EmptyArcType EmptyArcTypeParms
instance Eq EmptyGraph where
== :: EmptyGraph -> EmptyGraph -> Bool
(==) = (EmptyGraph -> ObjectID) -> EmptyGraph -> EmptyGraph -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
mapEq EmptyGraph -> ObjectID
oId
instance Ord EmptyGraph where
compare :: EmptyGraph -> EmptyGraph -> Ordering
compare = (EmptyGraph -> ObjectID) -> EmptyGraph -> EmptyGraph -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
mapOrd EmptyGraph -> ObjectID
oId
instance Destroyable EmptyGraph where
destroy :: EmptyGraph -> IO ()
destroy EmptyGraph
graph = Event () -> IO ()
forall a. Event a -> IO a
sync (Event () -> Event ()
forall a. Event a -> Event ()
noWait (Channel () -> () -> Event ()
forall (chan :: * -> *) a. HasSend chan => chan a -> a -> Event ()
send (EmptyGraph -> Channel ()
destructChan EmptyGraph
graph) ()))
instance Destructible EmptyGraph where
destroyed :: EmptyGraph -> Event ()
destroyed EmptyGraph
graph = Channel () -> Event ()
forall (chan :: * -> *) a. HasReceive chan => chan a -> Event a
receive (EmptyGraph -> Channel ()
destructChan EmptyGraph
graph)
instance HasDelayer EmptyGraph where
toDelayer :: EmptyGraph -> Delayer
toDelayer = EmptyGraph -> Delayer
delayer
instance GraphClass EmptyGraph where
redrawPrim :: EmptyGraph -> IO ()
redrawPrim EmptyGraph
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance NewGraph EmptyGraph EmptyGraphParms where
newGraphPrim :: EmptyGraphParms -> IO EmptyGraph
newGraphPrim EmptyGraphParms
_ =
do
Delayer
delayer <- IO Delayer
newDelayer
Channel ()
destructChan <- IO (Channel ())
forall a. IO (Channel a)
newChannel
ObjectID
oId <- IO ObjectID
newObject
let
graph :: EmptyGraph
graph = EmptyGraph :: Delayer -> Channel () -> ObjectID -> EmptyGraph
EmptyGraph {
delayer :: Delayer
delayer = Delayer
delayer,
destructChan :: Channel ()
destructChan = Channel ()
destructChan,
oId :: ObjectID
oId = ObjectID
oId
}
EmptyGraph -> IO EmptyGraph
forall (m :: * -> *) a. Monad m => a -> m a
return EmptyGraph
graph
instance GraphParms EmptyGraphParms where
emptyGraphParms :: EmptyGraphParms
emptyGraphParms = EmptyGraphParms
EmptyGraphParms
instance GraphConfig graphConfig
=> HasConfig graphConfig EmptyGraphParms where
$$ :: graphConfig -> EmptyGraphParms -> EmptyGraphParms
($$) graphConfig
_ EmptyGraphParms
parms = EmptyGraphParms
parms
configUsed :: graphConfig -> EmptyGraphParms -> Bool
configUsed graphConfig
_ EmptyGraphParms
_ = Bool
True
instance Eq1 EmptyNode where
eq1 :: EmptyNode value1 -> EmptyNode value1 -> Bool
eq1 = (EmptyNode value1 -> ObjectID)
-> EmptyNode value1 -> EmptyNode value1 -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
mapEq EmptyNode value1 -> ObjectID
forall value. EmptyNode value -> ObjectID
oIdN
instance Ord1 EmptyNode where
compare1 :: EmptyNode value1 -> EmptyNode value1 -> Ordering
compare1 = (EmptyNode value1 -> ObjectID)
-> EmptyNode value1 -> EmptyNode value1 -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
mapOrd EmptyNode value1 -> ObjectID
forall value. EmptyNode value -> ObjectID
oIdN
instance NodeClass EmptyNode
instance NodeTypeClass EmptyNodeType
instance NodeTypeParms EmptyNodeTypeParms where
emptyNodeTypeParms :: EmptyNodeTypeParms value
emptyNodeTypeParms = EmptyNodeTypeParms value
forall value. EmptyNodeTypeParms value
EmptyNodeTypeParms
coMapNodeTypeParms :: (value2 -> value1)
-> EmptyNodeTypeParms value1 -> EmptyNodeTypeParms value2
coMapNodeTypeParms value2 -> value1
_ EmptyNodeTypeParms value1
_ = EmptyNodeTypeParms value2
forall value. EmptyNodeTypeParms value
EmptyNodeTypeParms
instance NewNode EmptyGraph EmptyNode EmptyNodeType where
newNodePrim :: EmptyGraph -> EmptyNodeType value -> value -> IO (EmptyNode value)
newNodePrim EmptyGraph
_ EmptyNodeType value
_ value
value =
do
IORef value
ioRef <- value -> IO (IORef value)
forall a. a -> IO (IORef a)
newIORef value
value
ObjectID
oId <- IO ObjectID
newObject
let
node :: EmptyNode value
node = EmptyNode :: forall value. IORef value -> ObjectID -> EmptyNode value
EmptyNode {ioRefN :: IORef value
ioRefN = IORef value
ioRef,oIdN :: ObjectID
oIdN = ObjectID
oId}
EmptyNode value -> IO (EmptyNode value)
forall (m :: * -> *) a. Monad m => a -> m a
return EmptyNode value
node
setNodeTypePrim :: EmptyGraph -> EmptyNode value -> EmptyNodeType value -> IO ()
setNodeTypePrim EmptyGraph
_ EmptyNode value
_ EmptyNodeType value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance DeleteNode EmptyGraph EmptyNode where
deleteNodePrim :: EmptyGraph -> EmptyNode value -> IO ()
deleteNodePrim EmptyGraph
_ EmptyNode value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
getNodeValuePrim :: EmptyGraph -> EmptyNode value -> IO value
getNodeValuePrim EmptyGraph
_ EmptyNode value
node = IORef value -> IO value
forall a. IORef a -> IO a
readIORef (EmptyNode value -> IORef value
forall value. EmptyNode value -> IORef value
ioRefN EmptyNode value
node)
setNodeValuePrim :: EmptyGraph -> EmptyNode value -> value -> IO ()
setNodeValuePrim EmptyGraph
_ EmptyNode value
node = IORef value -> value -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (EmptyNode value -> IORef value
forall value. EmptyNode value -> IORef value
ioRefN EmptyNode value
node)
getMultipleNodesPrim :: EmptyGraph -> (Event (WrappedNode EmptyNode) -> IO a) -> IO a
getMultipleNodesPrim EmptyGraph
_ Event (WrappedNode EmptyNode) -> IO a
getA =
do
a
a <- Event (WrappedNode EmptyNode) -> IO a
getA Event (WrappedNode EmptyNode)
forall a. Event a
never
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
instance SetNodeFocus EmptyGraph EmptyNode where
setNodeFocusPrim :: EmptyGraph -> EmptyNode value -> IO ()
setNodeFocusPrim EmptyGraph
_ EmptyNode value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance NewNodeType EmptyGraph EmptyNodeType EmptyNodeTypeParms where
newNodeTypePrim :: EmptyGraph -> EmptyNodeTypeParms value -> IO (EmptyNodeType value)
newNodeTypePrim EmptyGraph
_ EmptyNodeTypeParms value
_ = EmptyNodeType value -> IO (EmptyNodeType value)
forall (m :: * -> *) a. Monad m => a -> m a
return EmptyNodeType value
forall value. EmptyNodeType value
EmptyNodeType
instance NodeTypeConfig nodeTypeConfig
=> HasConfigValue nodeTypeConfig EmptyNodeTypeParms where
$$$ :: nodeTypeConfig value
-> EmptyNodeTypeParms value -> EmptyNodeTypeParms value
($$$) nodeTypeConfig value
_ EmptyNodeTypeParms value
parms = EmptyNodeTypeParms value
parms
configUsed' :: nodeTypeConfig value -> EmptyNodeTypeParms value -> Bool
configUsed' nodeTypeConfig value
_ EmptyNodeTypeParms value
_ = Bool
True
instance HasModifyValue FontStyle EmptyGraph EmptyNode where
modify :: FontStyle -> EmptyGraph -> EmptyNode value -> IO ()
modify FontStyle
_ EmptyGraph
_ EmptyNode value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance HasModifyValue Border EmptyGraph EmptyNode where
modify :: Border -> EmptyGraph -> EmptyNode value -> IO ()
modify Border
_ EmptyGraph
_ EmptyNode value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance HasModifyValue NodeArcsHidden EmptyGraph EmptyNode where
modify :: NodeArcsHidden -> EmptyGraph -> EmptyNode value -> IO ()
modify NodeArcsHidden
_ EmptyGraph
_ EmptyNode value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
instance Eq1 EmptyArc where
eq1 :: EmptyArc value1 -> EmptyArc value1 -> Bool
eq1 = (EmptyArc value1 -> ObjectID)
-> EmptyArc value1 -> EmptyArc value1 -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
mapEq EmptyArc value1 -> ObjectID
forall value. EmptyArc value -> ObjectID
oIdE
instance Ord1 EmptyArc where
compare1 :: EmptyArc value1 -> EmptyArc value1 -> Ordering
compare1 = (EmptyArc value1 -> ObjectID)
-> EmptyArc value1 -> EmptyArc value1 -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
mapOrd EmptyArc value1 -> ObjectID
forall value. EmptyArc value -> ObjectID
oIdE
instance Eq1 EmptyArcType where
eq1 :: EmptyArcType value1 -> EmptyArcType value1 -> Bool
eq1 = (EmptyArcType value1 -> ObjectID)
-> EmptyArcType value1 -> EmptyArcType value1 -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
mapEq EmptyArcType value1 -> ObjectID
forall value. EmptyArcType value -> ObjectID
oIdET
instance Ord1 EmptyArcType where
compare1 :: EmptyArcType value1 -> EmptyArcType value1 -> Ordering
compare1 = (EmptyArcType value1 -> ObjectID)
-> EmptyArcType value1 -> EmptyArcType value1 -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
mapOrd EmptyArcType value1 -> ObjectID
forall value. EmptyArcType value -> ObjectID
oIdET
instance ArcClass EmptyArc
instance ArcTypeClass EmptyArcType where
invisibleArcType :: EmptyArcType value
invisibleArcType = EmptyArcType :: forall value. ObjectID -> EmptyArcType value
EmptyArcType {oIdET :: ObjectID
oIdET = Int -> ObjectID
staticObject Int
1}
instance ArcTypeParms EmptyArcTypeParms where
emptyArcTypeParms :: EmptyArcTypeParms value
emptyArcTypeParms = EmptyArcTypeParms value
forall value. EmptyArcTypeParms value
EmptyArcTypeParms
invisibleArcTypeParms :: EmptyArcTypeParms value
invisibleArcTypeParms = EmptyArcTypeParms value
forall value. EmptyArcTypeParms value
EmptyArcTypeParms
coMapArcTypeParms :: (value2 -> value1)
-> EmptyArcTypeParms value1 -> EmptyArcTypeParms value2
coMapArcTypeParms value2 -> value1
_ EmptyArcTypeParms value1
_ = EmptyArcTypeParms value2
forall value. EmptyArcTypeParms value
EmptyArcTypeParms
instance NewArcType EmptyGraph EmptyArcType EmptyArcTypeParms where
newArcTypePrim :: EmptyGraph -> EmptyArcTypeParms value -> IO (EmptyArcType value)
newArcTypePrim EmptyGraph
_ EmptyArcTypeParms value
_ =
do
ObjectID
oId <- IO ObjectID
newObject
EmptyArcType value -> IO (EmptyArcType value)
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyArcType :: forall value. ObjectID -> EmptyArcType value
EmptyArcType {oIdET :: ObjectID
oIdET = ObjectID
oId})
instance NewArc EmptyGraph EmptyNode EmptyNode EmptyArc EmptyArcType where
newArcPrim :: EmptyGraph
-> EmptyArcType value
-> value
-> EmptyNode nodeFromValue
-> EmptyNode nodeToValue
-> IO (EmptyArc value)
newArcPrim EmptyGraph
_ EmptyArcType value
_ value
value EmptyNode nodeFromValue
_ EmptyNode nodeToValue
_ =
do
IORef (Maybe value)
ioRef <- Maybe value -> IO (IORef (Maybe value))
forall a. a -> IO (IORef a)
newIORef (value -> Maybe value
forall a. a -> Maybe a
Just value
value)
ObjectID
oId <- IO ObjectID
newObject
EmptyArc value -> IO (EmptyArc value)
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyArc :: forall value. IORef (Maybe value) -> ObjectID -> EmptyArc value
EmptyArc {ioRefE :: IORef (Maybe value)
ioRefE = IORef (Maybe value)
ioRef,oIdE :: ObjectID
oIdE = ObjectID
oId})
newArcListDrawerPrim :: EmptyGraph
-> EmptyNode nodeFromValue
-> ListDrawer
(EmptyArcType value, value, WrappedNode EmptyNode) (EmptyArc value)
newArcListDrawerPrim EmptyGraph
_ EmptyNode nodeFromValue
_ = ListDrawer
(EmptyArcType value, value, WrappedNode EmptyNode) (EmptyArc value)
forall value.
ListDrawer
(EmptyArcType value, value, WrappedNode EmptyNode) (EmptyArc value)
listDrawer
instance SetArcType EmptyGraph EmptyArc EmptyArcType where
setArcTypePrim :: EmptyGraph -> EmptyArc value -> EmptyArcType value -> IO ()
setArcTypePrim EmptyGraph
_ EmptyArc value
_ EmptyArcType value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
listDrawer :: ListDrawer
(EmptyArcType value,value,WrappedNode EmptyNode) (EmptyArc value)
listDrawer :: ListDrawer
(EmptyArcType value, value, WrappedNode EmptyNode) (EmptyArc value)
listDrawer =
let
newPos :: p -> Maybe (a, value, c) -> IO (EmptyArc value)
newPos p
_ Maybe (a, value, c)
endOpt =
do
IORef (Maybe value)
ioRef <- Maybe value -> IO (IORef (Maybe value))
forall a. a -> IO (IORef a)
newIORef (Maybe (a, value, c) -> Maybe value
forall a b c. Maybe (a, b, c) -> Maybe b
mapOpt Maybe (a, value, c)
endOpt)
ObjectID
oId <- IO ObjectID
newObject
EmptyArc value -> IO (EmptyArc value)
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyArc :: forall value. IORef (Maybe value) -> ObjectID -> EmptyArc value
EmptyArc {ioRefE :: IORef (Maybe value)
ioRefE = IORef (Maybe value)
ioRef,oIdE :: ObjectID
oIdE = ObjectID
oId})
setPos :: EmptyArc value -> Maybe (a, value, c) -> IO ()
setPos (EmptyArc {ioRefE :: forall value. EmptyArc value -> IORef (Maybe value)
ioRefE = IORef (Maybe value)
ioRef}) Maybe (a, value, c)
endOpt =
IORef (Maybe value) -> Maybe value -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe value)
ioRef (Maybe (a, value, c) -> Maybe value
forall a b c. Maybe (a, b, c) -> Maybe b
mapOpt Maybe (a, value, c)
endOpt)
delPos :: p -> m ()
delPos p
_ = m ()
forall (m :: * -> *). Monad m => m ()
done
mapOpt :: Maybe (a, b, c) -> Maybe b
mapOpt = ((a, b, c) -> b) -> Maybe (a, b, c) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ (a
_,b
value,c
_) -> b
value)
in
ListDrawer :: forall a pos.
(Maybe pos -> Maybe a -> IO pos)
-> (pos -> Maybe a -> IO ())
-> (pos -> IO ())
-> IO ()
-> ListDrawer a pos
ListDrawer {
newPos :: Maybe (EmptyArc value)
-> Maybe (EmptyArcType value, value, WrappedNode EmptyNode)
-> IO (EmptyArc value)
newPos = Maybe (EmptyArc value)
-> Maybe (EmptyArcType value, value, WrappedNode EmptyNode)
-> IO (EmptyArc value)
forall p a value c. p -> Maybe (a, value, c) -> IO (EmptyArc value)
newPos,
setPos :: EmptyArc value
-> Maybe (EmptyArcType value, value, WrappedNode EmptyNode)
-> IO ()
setPos = EmptyArc value
-> Maybe (EmptyArcType value, value, WrappedNode EmptyNode)
-> IO ()
forall value a c. EmptyArc value -> Maybe (a, value, c) -> IO ()
setPos,
delPos :: EmptyArc value -> IO ()
delPos = EmptyArc value -> IO ()
forall (m :: * -> *) p. Monad m => p -> m ()
delPos,
redraw :: IO ()
redraw = IO ()
forall (m :: * -> *). Monad m => m ()
done
}
instance DeleteArc EmptyGraph EmptyArc where
deleteArcPrim :: EmptyGraph -> EmptyArc value -> IO ()
deleteArcPrim EmptyGraph
_ EmptyArc value
_ = IO ()
forall (m :: * -> *). Monad m => m ()
done
setArcValuePrim :: EmptyGraph -> EmptyArc value -> value -> IO ()
setArcValuePrim EmptyGraph
_ (EmptyArc {ioRefE :: forall value. EmptyArc value -> IORef (Maybe value)
ioRefE = IORef (Maybe value)
ioRef}) value
value =
IORef (Maybe value) -> Maybe value -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe value)
ioRef (value -> Maybe value
forall a. a -> Maybe a
Just value
value)
getArcValuePrim :: EmptyGraph -> EmptyArc value -> IO value
getArcValuePrim EmptyGraph
_ (EmptyArc {ioRefE :: forall value. EmptyArc value -> IORef (Maybe value)
ioRefE = IORef (Maybe value)
ioRef}) =
do
Maybe value
valueOpt <- IORef (Maybe value) -> IO (Maybe value)
forall a. IORef a -> IO a
readIORef IORef (Maybe value)
ioRef
case Maybe value
valueOpt of
Just value
value -> value -> IO value
forall (m :: * -> *) a. Monad m => a -> m a
return value
value
instance ArcTypeConfig arcTypeConfig
=> HasConfigValue arcTypeConfig EmptyArcTypeParms where
$$$ :: arcTypeConfig value
-> EmptyArcTypeParms value -> EmptyArcTypeParms value
($$$) arcTypeConfig value
_ EmptyArcTypeParms value
parms = EmptyArcTypeParms value
parms
configUsed' :: arcTypeConfig value -> EmptyArcTypeParms value -> Bool
configUsed' arcTypeConfig value
_ EmptyArcTypeParms value
_ = Bool
True