INblobs-0.1.1: src/Operations.hs

module Operations where

import Network
import State
import Document
import qualified PersistentDocument as PD

import Data.IntMap

-- | @GraphOps@ is a data structure holding a bunch of named operations
--   on the document.  The operations are classified into pure and
--   IO variants.  A pure operation takes a document and returns a new
--   document and displayed immediately.  An IO operation is simply
--   executed taking the document as argument and the state.
data GraphOps g n e = GraphOps
    { pureOps :: [ (String, PureOp g n e) ]
    , ioOps   :: [ (String, IOOp g n e) ]
    }
type PureOp g n e = -- (InfoKind n g, InfoKind e g)
                    Document g n e -> Document g n e
type IOOp g n e  = -- (InfoKind n g, InfoKind e g) =>
                   Document g n e -> State g n e -> IO ()

type PureNetworkOp g n e = -- (InfoKind n g, InfoKind e g)
                       (g, IntMap (Node n), IntMap (Edge e))
                    -> (g, IntMap (Node n), IntMap (Edge e))
type IONetworkOp g n e  = -- (InfoKind n g, InfoKind e g) =>
                       (g, IntMap (Node n), IntMap (Edge e))
                    -> State g n e
                    -> IO ()

callPureGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()
callPureGraphOp opName allGraphOps state = 
  do{ pDoc <- getDocument state
    ; let operation  = maybe id id (Prelude.lookup opName (pureOps allGraphOps))
    ; PD.updateDocument opName operation pDoc
    }

callIOGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()
callIOGraphOp opName allGraphOps state =
  do{ pDoc <- getDocument state
    ; doc  <- PD.getDocument pDoc
    ; maybe (return ()) (\op-> op doc state)
                        (Prelude.lookup opName (ioOps allGraphOps))
    }


globalizePure :: PureNetworkOp g n e -> PureOp g n e
globalizePure netOperation = updateNetwork aux
   where aux network = 
           let g = getGlobalInfo network
               n = networkNodes network
               e = networkEdges network
               (g',n',e') = netOperation (g,n,e)
            in setNodeAssocs (assocs n')
                     . setEdgeAssocs (assocs e')
                     . setGlobalInfo g'
                     $ network

globalizeIO :: IONetworkOp g n e -> IOOp g n e
globalizeIO netOperation doc state = 
  do{ let network = getNetwork doc
          g = getGlobalInfo network
          n = networkNodes network
          e = networkEdges network
    ; netOperation (g, n, e) state
    }