INblobs-0.1: src/Main.hs

module Main (main, gain) where

import NetworkUI
import Graphics.UI.WX
import Graphics.UI.WXCore
import State
import InfoKind

import Network
import Operations
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List (nub)
import Data.Maybe (fromJust, fromMaybe)
import qualified PersistentDocument as PD
import INTextual
import INTextualUI
import SafetyNet
import INChecksUI
import CommonUI

import Text.XML.HaXml.XmlContent (XmlContent)

import System.Cmd
import System.Exit

--import EnableGUI


main :: IO ()
main = start $
  do{ state <- State.empty
    ; NetworkUI.create state () [] [] graphOps
    }

instance InfoKind Int () where
    blank = 0
    check n _ i | i<0 = ["Number should not be negative in "++n]
                | otherwise = []
instance InfoKind [Int] () where
    blank = []
    check _ _ _ = []

-- A simple range of operations on a graph network.
graphOps :: GraphOps () [Int] [Int]
graphOps = GraphOps { pureOps = [ ]
                    , ioOps = [ ("Generate textual description"
                                , genTextual)
			      , ("Compile through external compiler", compilePIN)
                              ] }

-- Every edge is augmented with the sum of the numbers in its from-node.
pushAlongEdge :: IntMap (Node [Int]) -> Edge [Int] -> Edge [Int]
nodemap `pushAlongEdge` edge = setEdgeInfo (nub (sum n: getEdgeInfo edge)) edge
  where n = (getInfo . fromJust . flip IntMap.lookup nodemap . getEdgeFrom)
            edge

-- Every node is augmented with a list of all the numbers in its incoming edges.
accumulateIn :: IntMap (Edge [Int]) -> NodeNr -> Node [Int] -> Node [Int]
(edgemap `accumulateIn` nr) node = setInfo (nub (es++getInfo node)) node
  where es = (concat . IntMap.elems
             . IntMap.map getEdgeInfo
             . IntMap.filter (\e-> getEdgeTo e == nr) )
             edgemap

gain :: IO ()
gain = main -- :-)

compilePIN :: (InfoKind n g, InfoKind e g, XmlContent g, Show g) => IOOp g n e
compilePIN doc state =
     do
	logMessage "Compiling in PIN"
	pDoc <- getDocument state
	inName <- PD.getFileName pDoc
	theFrame <- getNetworkFrame state

	let fn  = changeExt ".INblobs" "-PIN" $ fromMaybe "" inName
	    fnN = fn ++ ".net"
	    fnI = fn ++ ".INblobs"

	writeFile fnI . showRepresentation PIN . simplify $ doc2net doc
	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"
	when (not $ null comm) $
	     do
		let command = subst fnN fnI comm
		putStrLn command 
		ec <- system command
		case ec of
	  	   ExitSuccess ->
	     		safetyNet theFrame $
			  openNetworkFile fnI state (Just theFrame)
			  >> singleCheckOverIN iNCheck state
	           ExitFailure n -> errorDialog theFrame "Compiling through external compiler"
				$ "Error compiling through external compiler:\n"
				++ show ec
  where subst inp out [] = []
	subst inp out ('#':'i':str) = inp ++ subst inp out str
	subst inp out ('#':'o':str) = out ++ subst inp out str
	subst inp out (c:str) = c : subst inp out str