darcs - INblobs

1 module Main (main, gain) where

3 import NetworkUI

4 import Graphics.UI.WX

5 import Graphics.UI.WXCore

6 import State

7 import InfoKind

9 import Network

10 import Operations

11 import Data.IntMap (IntMap)

12 import qualified Data.IntMap as IntMap

13 import Data.List (nub)

14 import Data.Maybe (fromJust, fromMaybe)

15 import qualified PersistentDocument as PD

16 import INTextual

17 import INTextualUI

18 import SafetyNet

19 import INChecksUI

20 import CommonUI

22 import Text.XML.HaXml.XmlContent (XmlContent)

24 import System.Cmd

25 import System.Exit

27 --import EnableGUI

30 main :: IO ()

31 main = start $

32 do{ state <- State.empty

33 ; NetworkUI.create state () [] [] graphOps

34 }

36 instance InfoKind Int () where

37 blank = 0

38 check n _ i | i<0 = ["Number should not be negative in "++n]

39 | otherwise = []

40 instance InfoKind [Int] () where

41 blank = []

42 check _ _ _ = []

44 -- A simple range of operations on a graph network.

45 graphOps :: GraphOps () [Int] [Int]

46 graphOps = GraphOps { pureOps = [ ]

47 , ioOps = [ ("Generate textual description"

48 , genTextual)

49 , ("Compile through external compiler", compilePIN)

50 ] }

52 -- Every edge is augmented with the sum of the numbers in its from-node.

53 pushAlongEdge :: IntMap (Node [Int]) -> Edge [Int] -> Edge [Int]

54 nodemap `pushAlongEdge` edge = setEdgeInfo (nub (sum n: getEdgeInfo edge)) edge

55 where n = (getInfo . fromJust . flip IntMap.lookup nodemap . getEdgeFrom)

56 edge

58 -- Every node is augmented with a list of all the numbers in its incoming edges.

59 accumulateIn :: IntMap (Edge [Int]) -> NodeNr -> Node [Int] -> Node [Int]

60 (edgemap `accumulateIn` nr) node = setInfo (nub (es++getInfo node)) node

61 where es = (concat . IntMap.elems

62 . IntMap.map getEdgeInfo

63 . IntMap.filter (\e-> getEdgeTo e == nr) )

64 edgemap

66 gain :: IO ()

67 gain = main -- :-)

69 compilePIN :: (InfoKind n g, InfoKind e g, XmlContent g, Show g) => IOOp g n e

70 compilePIN doc state =

71 do

72 logMessage "Compiling in PIN"

73 pDoc <- getDocument state

74 inName <- PD.getFileName pDoc

75 theFrame <- getNetworkFrame state

77 let fn = changeExt ".INblobs" "-PIN" $ fromMaybe "" inName

78 fnN = fn ++ ".net"

79 fnI = fn ++ ".INblobs"

81 writeFile fnI . showRepresentation PIN . simplify $ doc2net doc

82 comm <- textDialog theFrame "Command to invoque external compiler.\nThis special tokens can be used:\n#i for FILE.net\n#o for FILE.INblobs" "Compiling through external compiler" "java pin.compiler.Main #i"

83 when (not $ null comm) $

84 do

85 let command = subst fnN fnI comm

86 putStrLn command

87 ec <- system command

88 case ec of

89 ExitSuccess ->

90 safetyNet theFrame $

91 openNetworkFile fnI state (Just theFrame)

92 >> singleCheckOverIN iNCheck state

93 ExitFailure n -> errorDialog theFrame "Compiling through external compiler"

94 $ "Error compiling through external compiler:\n"

95 ++ show ec

96 where subst inp out [] = []

97 subst inp out ('#':'i':str) = inp ++ subst inp out str

98 subst inp out ('#':'o':str) = out ++ subst inp out str

99 subst inp out (c:str) = c : subst inp out str

100