{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | This module describes an empty display graph sort.  In other words, it
-- displays nothing.  Not a lot of use you might think, but we use it for
-- the MMiSS API to get a version graph without invoking daVinci.
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

-- ---------------------------------------------------------------------------
-- Datatypes
-- ---------------------------------------------------------------------------

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

-- ---------------------------------------------------------------------------
-- The sort
-- ---------------------------------------------------------------------------

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

-- ---------------------------------------------------------------------------
-- Instances for EmptyGraph/EmptyGraphParms
-- ---------------------------------------------------------------------------

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

-- ---------------------------------------------------------------------------
-- Instances for EmptyNode, EmptyNodeType, EmptyNodeTypeParms
-- ---------------------------------------------------------------------------

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

-- ---------------------------------------------------------------------------
-- Instances for EmptyArc, EmptyArcType, EmptyArcTypeParms
-- ---------------------------------------------------------------------------

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