darcs - INblobs

1 module Operations where

3 import Network

4 import State

5 import Document

6 import qualified PersistentDocument as PD

8 import Data.IntMap

10 -- | @GraphOps@ is a data structure holding a bunch of named operations

11 -- on the document. The operations are classified into pure and

12 -- IO variants. A pure operation takes a document and returns a new

13 -- document and displayed immediately. An IO operation is simply

14 -- executed taking the document as argument and the state.

15 data GraphOps g n e = GraphOps

16 { pureOps :: [ (String, PureOp g n e) ]

17 , ioOps :: [ (String, IOOp g n e) ]

18 }

19 type PureOp g n e = -- (InfoKind n g, InfoKind e g)

20 Document g n e -> Document g n e

21 type IOOp g n e = -- (InfoKind n g, InfoKind e g) =>

22 Document g n e -> State g n e -> IO ()

24 type PureNetworkOp g n e = -- (InfoKind n g, InfoKind e g)

25 (g, IntMap (Node n), IntMap (Edge e))

26 -> (g, IntMap (Node n), IntMap (Edge e))

27 type IONetworkOp g n e = -- (InfoKind n g, InfoKind e g) =>

28 (g, IntMap (Node n), IntMap (Edge e))

29 -> State g n e

30 -> IO ()

32 callPureGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()

33 callPureGraphOp opName allGraphOps state =

34 do{ pDoc <- getDocument state

35 ; let operation = maybe id id (Prelude.lookup opName (pureOps allGraphOps))

36 ; PD.updateDocument opName operation pDoc

37 }

39 callIOGraphOp :: String -> GraphOps g n e -> State g n e -> IO ()

40 callIOGraphOp opName allGraphOps state =

41 do{ pDoc <- getDocument state

42 ; doc <- PD.getDocument pDoc

43 ; maybe (return ()) (\op-> op doc state)

44 (Prelude.lookup opName (ioOps allGraphOps))

45 }

48 globalizePure :: PureNetworkOp g n e -> PureOp g n e

49 globalizePure netOperation = updateNetwork aux

50 where aux network =

51 let g = getGlobalInfo network

52 n = networkNodes network

53 e = networkEdges network

54 (g',n',e') = netOperation (g,n,e)

55 in setNodeAssocs (assocs n')

56 . setEdgeAssocs (assocs e')

57 . setGlobalInfo g'

58 $ network

60 globalizeIO :: IONetworkOp g n e -> IOOp g n e

61 globalizeIO netOperation doc state =

62 do{ let network = getNetwork doc

63 g = getGlobalInfo network

64 n = networkNodes network

65 e = networkEdges network

66 ; netOperation (g, n, e) state

67 }