{- 
 - 	Monadic Constraint Programming
 - 	http://www.cs.kuleuven.be/~toms/MCP/
 - 	Pieter Wuille
 -}



{-# LANGUAGE RankNTypes #-}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# LANGUAGE StandaloneDeriving #-}

{-# LANGUAGE FlexibleInstances #-}



module Control.CP.FD.Graph (

  EGConstraintSpec(..),

  EGParTerm(..),

  EGParBoolTerm(..),

  EGParColTerm(..),

  EGPar, EGBoolPar, EGColPar,

  EGConsArgs,

  EGEdgeId,

  EGVarId(..),

  EGVarType(..),

  EGTypeData(..),

  EGEdge(..),

  EGModel(..),

  addEdge,

  addNode,

  delNode,

  findEdge,

  unifyNodes,

  unifyIds,

  baseGraph,

  baseTypeData,

  egTypeDataMap, egTypeGet, egTypeMod,

  present,

  getConnectedEdges,

  externMap, filterModel, emptyModel, pruneNodes,

) where



import Control.Monad (foldM)



import Data.Maybe (fromJust)

import Data.Map (Map)

import qualified Data.Map as Map



import Data.Expr.Data

-- import Control.CP.FD.Expr.Util



-- BoolEqual, Rel _ (EREqual) _, ColEqual are encoded in the graph itself, and

-- not represented as constraints between them



data EGVarType = 

    EGBoolType

  | EGIntType

  | EGColType

  deriving (Eq,Show)



-- instance KeyableExpr EGConstraintSpec where

--  keyCompare a b = compare a b



data EGConstraintSpec =

    EGIntValue EGPar                 -- i0 == p

  | EGBoolValue EGBoolPar            -- b0 == p

  | EGColValue EGColPar              -- c0 == p

  | EGIntExtern Int                  -- super[p] == i0

  | EGBoolExtern Int                 -- super[p] == b0

  | EGColExtern Int                  -- super[p] == c0

  | EGPlus                           -- i0==i1+i2

  | EGMinus                          -- i0==i1-i2

  | EGMult                           -- i0==i1*i2

  | EGDiv                            -- i0==i1/i2   {- (i0==i1/i2) is NOT the same as (i1==i0*i2) -}

  | EGMod                            -- i0==i1%i2  

  | EGAbs                            -- i0==abs(i1)

  | EGAt                             -- i0==c0[i1]

  | EGFold EGModel (Int,Int,Int)     -- i0==fold(p,i1,c0)  {- inner intExtern(-1) is fold-function's return value, intExtern(-2) is the accumulator, intExtern(-3) is the argument -}

  | EGSize                           -- i0==size(c0)

  | EGChannel                        -- int(b0) == i0

  | EGList Int                       -- c0 == [i0,i1,i2,...] (len p) 

  | EGRange                          -- c0 == [i0..i1]

  | EGMap EGModel (Int,Int,Int)      -- c0 == map(p,c1)    {- inner intExtern(-1) is map-function's return value, intExtern(-2) is its argument -}

  | EGSlice EGModel (Int,Int,Int)    -- c0 == c1[f(0)...f(i0-1)]; inner model defines f: intExtern(-1) is return value, intExtern(-2) is its argument

--  | EGSlice (EGPar -> EGPar) EGPar   -- c0 == c1[f(0)...f(n-1)]

  | EGCat                            -- c0 == c1++c2

  | EGAnd                            -- b0 == b1 && b2

  | EGOr                             -- b0 == b1 || b2

  | EGEquiv                          -- b0 == (b1 == b2)

  | EGNot                            -- b0 == !b1

  | EGEqual                          -- b0 <-> i0 == i1

  | EGDiff                           -- b0 <-> i0 /= i1

  | EGLess Bool                      -- false: b0 <-> i0 <= i1 ; true: b0 <-> i0 < i1

  | EGAll EGModel (Int,Int,Int) Bool -- b0 <-> foreach (i from c0): p(i)  {- inner boolExtern(-1) is truth value of predicate, intExtern(-1) is its argument; bool is true if all inner predicates need to be true -}

  | EGAny EGModel (Int,Int,Int) Bool -- b0 <-> forany (i from c0): p(i)   {- inner boolExtern(-1) is truth value of predicate, intExtern(-1) is its argument; bool is true if all inner predicates need to be false -}

--  | EGAllC EGModel (Int,Int,Int) Bool -- b0 <-> foreach (i from [i0,i1]: p(i) {- inner boolExtern(-1) is truth value of predicate, intExtern(-1) is its (constant) argument; bool is true if all inner predicates need to be true -}

--  | EGAnyC EGModel (Int,Int,Int) Bool -- b0 <-> foreach (i from [i0,i1]: p(i) {- inner boolExtern(-1) is truth value of predicate, intExtern(-1) is its (constant) argument; bool is true if all inner predicates need to be true -}

  | EGSorted Bool                    -- c0 is increasing (false), or strictly increasing (true)

  | EGAllDiff Bool                   -- c0 is all different (b0 means: use in consistency)

  | EGDom                            -- i0 is any of c0

  | EGCondEqual                      -- b0 ? (b1==b2) : true

  | EGCondInt                        -- i0 = b0 ? i1 : i2

  deriving (Eq,Show)



instance Ord (EGPar -> EGPar) where

  compare a b = compare (a (Term (EGPTParam (-1)))) (b (Term (EGPTParam (-1))))



instance Eq (EGPar -> EGPar) where

  a == b = (a (Term (EGPTParam (-1)))) == (b (Term (EGPTParam (-1))))



instance Show (EGPar -> EGPar) where

  show f = show $ f (Term (EGPTParam (-1)))



dummyConstraint :: EGConstraintSpec -> Bool

dummyConstraint c = case c of

  EGIntExtern _ -> True

  EGBoolExtern _ -> True

  EGColExtern _ -> True

  _ -> False



data EGParTerm =

    EGPTParam Int

  deriving (Show,Eq,Ord)

  

data EGParBoolTerm =

    EGPTBoolParam Int

  deriving (Show,Eq,Ord)



data EGParColTerm =

    EGPTColParam Int

  deriving (Show,Eq,Ord)



type EGPar =     Expr     EGParTerm EGParColTerm EGParBoolTerm

type EGBoolPar = BoolExpr EGParTerm EGParColTerm EGParBoolTerm

type EGColPar =  ColExpr  EGParTerm EGParColTerm EGParBoolTerm



-- Bools, Ints, Cols

type EGConsArgs = (Int,Int,Int)



getConsArgs :: EGConstraintSpec -> EGTypeData Int

getConsArgs x = case

  case x of

    EGBoolValue _    -> (1,0,0)

    EGIntValue _     -> (0,1,0)

    EGColValue _     -> (0,0,1)

    EGIntExtern _    -> (0,1,0)

    EGBoolExtern _   -> (1,0,0)

    EGColExtern _    -> (0,0,1)

    EGPlus           -> (0,3,0)

    EGMinus          -> (0,3,0)

    EGMult           -> (0,3,0)

    EGDiv            -> (0,3,0)

    EGMod            -> (0,3,0)

    EGAbs            -> (0,2,0)

    EGAt             -> (0,2,1)

    EGFold _ (a,b,c) -> (a,2+b,1+c)

    EGSize           -> (0,1,1)

    EGChannel        -> (1,1,0)

    EGList n         -> (0,n,1)

    EGRange          -> (0,2,1)

    EGMap _ (a,b,c)  -> (a,b,2+c)

    EGSlice _ (a,b,c) -> (a,1+b,2+c)

    EGCat            -> (0,0,3)

    EGAnd            -> (3,0,0)

    EGOr             -> (3,0,0)

    EGEquiv          -> (3,0,0)

    EGNot            -> (2,0,0)

    EGEqual          -> (1,2,0)

    EGDiff           -> (1,2,0)

    EGLess _         -> (1,2,0)

    EGAll _ (a,b,c) _ -> (1+a,b,1+c)

    EGAny _ (a,b,c) _ -> (1+a,b,1+c)

--    EGAllC _ (a,b,c) _ -> (1+a,2+b,c)

--    EGAnyC _ (a,b,c) _ -> (1+a,2+b,c)

    EGSorted _       -> (0,0,1)

    EGAllDiff _      -> (0,0,1)

    EGDom            -> (0,1,1)

    EGCondEqual      -> (3,0,0)

    EGCondInt        -> (1,3,0)

  of (a,b,c) -> EGTypeData { boolData = a, intData = b, colData =c }



newtype EGEdgeId = EGEdgeId { unEGEdgeId :: Int }

  deriving (Eq,Ord,Show)



data EGVarId = EGVarId { unVarId :: Int }

  deriving (Eq,Ord,Show)



data EGTypeData x = EGTypeData {

  boolData :: x,

  intData :: x,

  colData :: x

}



deriving instance Show x => Show (EGTypeData x)

deriving instance Eq x => Eq (EGTypeData x)



baseTypeData :: x -> EGTypeData x

baseTypeData x = EGTypeData {

  boolData = x,

  intData = x,

  colData = x

}



egTypeDataMap :: ((forall a. EGTypeData a -> a) -> b) -> EGTypeData b

egTypeDataMap f = EGTypeData {

  boolData = f boolData,

  intData = f intData,

  colData = f colData

}



egTypeGet :: EGVarType -> EGTypeData a -> a

egTypeGet EGBoolType = boolData

egTypeGet EGIntType = intData

egTypeGet EGColType = colData



egTypeMod :: EGVarType -> EGTypeData a -> (a -> a) -> EGTypeData a

egTypeMod EGBoolType d f = d { boolData = f $ boolData d }

egTypeMod EGIntType d f = d { intData = f $ intData d }

egTypeMod EGColType d f = d { colData = f $ colData d }



data EGEdge = EGEdge {

  egeCons :: EGConstraintSpec,

  egeLinks :: EGTypeData [EGVarId]

} deriving (Eq,Show)



showBool :: EGVarId -> String

showBool (EGVarId i) = "b" ++ (show i)

showInt :: EGVarId -> String

showInt (EGVarId i) = "i" ++ (show i)

showCol :: EGVarId -> String

showCol (EGVarId i) = "c" ++ (show i)



showLst :: (EGVarId -> String) -> [EGVarId] -> String

showLst _ [] = "[]"

showLst f x = "[" ++ (foldl1 (\x y -> x ++ "," ++ y) $ map f x) ++ "]"



instance Display EGEdge where

  displayer (EGEdge { egeCons = EGBoolValue i, egeLinks = EGTypeData { boolData = [l] } }) = displaySingle $ (showBool l) ++ " == " ++ "#["++(show i)++"]"

  displayer (EGEdge { egeCons = EGIntValue i, egeLinks =  EGTypeData { intData = [l] }}) = displaySingle $ (showInt l) ++ " == " ++ "#["++(show i)++"]"

  displayer (EGEdge { egeCons = EGColValue i, egeLinks =  EGTypeData { colData = [l] }}) = displaySingle $ (showCol l) ++ " == " ++ "#["++(show i)++"]"

  displayer (EGEdge { egeCons = EGBoolExtern i, egeLinks = EGTypeData  { boolData = [l] }}) = displaySingle $ (showBool l) ++ " == parentBool[" ++ (show i) ++ "]"

  displayer (EGEdge { egeCons = EGIntExtern i, egeLinks =  EGTypeData { intData = [l] }}) = displaySingle $ (showInt l) ++ " == parentInt[" ++ (show i) ++ "]"

  displayer (EGEdge { egeCons = EGColExtern i, egeLinks = EGTypeData  { colData = [l] }}) = displaySingle $ (showCol l) ++ " == parentCol[" ++ (show i) ++ "]"

  displayer (EGEdge { egeCons = EGPlus, egeLinks =  EGTypeData { intData=[a,b,c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showInt b) ++ " + " ++ (showInt c)

  displayer (EGEdge { egeCons = EGMinus, egeLinks =  EGTypeData { intData=[a,b,c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showInt b) ++ " - " ++ (showInt c)

  displayer (EGEdge { egeCons = EGMult, egeLinks =  EGTypeData { intData=[a,b,c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showInt b) ++ " * " ++ (showInt c)

  displayer (EGEdge { egeCons = EGDiv, egeLinks =  EGTypeData { intData=[a,b,c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showInt b) ++ " / " ++ (showInt c)

  displayer (EGEdge { egeCons = EGMod, egeLinks =  EGTypeData { intData=[a,b,c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showInt b) ++ " % " ++ (showInt c)

  displayer (EGEdge { egeCons = EGAbs, egeLinks =  EGTypeData { intData=[a,b] }}) = displaySingle $ (showInt a) ++ " == abs(" ++ (showInt b) ++ ")"

  displayer (EGEdge { egeCons = EGAt, egeLinks =  EGTypeData { intData=[a,b], colData=[c] }}) = displaySingle $ (showInt a) ++ " == " ++ (showCol c) ++ "[" ++ (showInt b) ++ "]"

  displayer (EGEdge { egeCons = EGSize, egeLinks =  EGTypeData { intData=[a], colData=[c] }}) = displaySingle $ (showInt a) ++ " == size(" ++ (showCol c) ++ ")"

  displayer (EGEdge { egeCons = EGDom, egeLinks =  EGTypeData { intData=[a], colData=[c] }}) = displaySingle $ ("dom(" ++ (showInt a) ++ ") == " ++ (showCol c))

  displayer (EGEdge { egeCons = EGChannel, egeLinks =  EGTypeData { boolData=[a], intData=[b] }}) = displaySingle $ (showBool a) ++ " == " ++ (showInt b)

  displayer (EGEdge { egeCons = EGList 0, egeLinks =  EGTypeData { colData=[c] }}) = displaySingle $ (showCol c) ++ " == []"

  displayer (EGEdge { egeCons = EGList _, egeLinks =  EGTypeData { intData=l, colData=[c] }}) = displaySingle $ (showCol c) ++ " == ["++(foldl1 (\a b -> a ++","++b) $ map showInt l)++"]"

  displayer (EGEdge { egeCons = EGAllDiff _, egeLinks =  EGTypeData { colData=[c] }}) = displaySingle $ "allDiff " ++ (showCol c)

  displayer (EGEdge { egeCons = EGSorted b, egeLinks =  EGTypeData { colData=[c] }}) = displaySingle $ "sorted " ++ (show b) ++ " " ++ (showCol c)

  displayer (EGEdge { egeCons = EGRange, egeLinks =  EGTypeData { intData=[l,h], colData=[c] }}) = displaySingle $ (showCol c) ++ " == ["++(showInt l)++".."++(showInt h)++"]"

--  displayer (EGEdge { egeCons = EGSlice f n, egeLinks =  EGTypeData { colData=[c,o] }}) = displaySingle $ (showCol c) ++ " == "++(showCol o)++"[f(0)..f("++(show n)++"-1)]"

  displayer (EGEdge { egeCons = EGCat, egeLinks =  EGTypeData { colData=[c,a,b] }}) = displaySingle $ (showCol c) ++ " == "++(showCol a)++"++"++(showCol b)

  displayer (EGEdge { egeCons = EGAnd, egeLinks =  EGTypeData { boolData=[c,a,b] }}) = displaySingle $ (showBool c) ++ " == "++(showBool a)++" && "++(showBool b)

  displayer (EGEdge { egeCons = EGOr, egeLinks =  EGTypeData { boolData=[c,a,b] }}) = displaySingle $ (showBool c) ++ " == "++(showBool a)++" || "++(showBool b)

  displayer (EGEdge { egeCons = EGEquiv, egeLinks =  EGTypeData { boolData=[c,a,b] }}) = displaySingle $ (showBool c) ++ " == ("++(showBool a)++" == "++(showBool b)++")"

  displayer (EGEdge { egeCons = EGNot, egeLinks =  EGTypeData { boolData=[c,a] }}) = displaySingle $ (showBool c) ++ " == !"++(showBool a)

  displayer (EGEdge { egeCons = EGEqual, egeLinks =  EGTypeData { boolData=[r], intData=[a,b] }}) = displaySingle $ (showBool r) ++ " == ("++(showInt a)++" == "++(showInt b)++")"

  displayer (EGEdge { egeCons = EGDiff, egeLinks =  EGTypeData { boolData=[r], intData=[a,b] }}) = displaySingle $ (showBool r) ++ " == ("++(showInt a)++" != "++(showInt b)++")"

  displayer (EGEdge { egeCons = EGLess q, egeLinks =  EGTypeData { boolData=[r], intData=[a,b] }}) = displaySingle $ (showBool r) ++ " == ("++(showInt a)++(if q then " < " else " <= ")++(showInt b)++")"

  displayer (EGEdge { egeCons = EGAll s _ _, egeLinks = EGTypeData { boolData=r:ab, intData=ai, colData=c:ac }}) = DisplayData ((showBool r)++" == forall("++(showCol c)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

  displayer (EGEdge { egeCons = EGAny s _ _, egeLinks = EGTypeData { boolData=r:ab, intData=ai, colData=c:ac }}) = DisplayData ((showBool r)++" == forany("++(showCol c)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

--  displayer (EGEdge { egeCons = EGAllC s _ _, egeLinks = EGTypeData { boolData=r:ab, intData=l:h:ai, colData=ac }}) = DisplayData ((showBool r)++" == forall("++(showInt l)++".."++(showInt h)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

--  displayer (EGEdge { egeCons = EGAnyC s _ _, egeLinks = EGTypeData { boolData=r:ab, intData=l:h:ai, colData=ac }}) = DisplayData ((showBool r)++" == forany("++(showInt l)++".."++(showInt h)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

  displayer (EGEdge { egeCons = EGMap s _, egeLinks = EGTypeData { boolData=ab, intData=ai, colData=r:c:ac }}) = DisplayData ((showCol r)++" == map("++(showCol c)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

  displayer (EGEdge { egeCons = EGSlice s _, egeLinks = EGTypeData { boolData=ab, intData=n:ai, colData=r:c:ac }}) = DisplayData ((showCol r)++" == slice("++(showCol c)++",0..("++(showInt n)++")-1) "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

  displayer (EGEdge { egeCons = EGFold s _, egeLinks = EGTypeData { boolData=ab, intData=r:i:ai, colData=c:ac }}) = DisplayData ((showInt r)++" == fold("++(showCol c)++","++(showInt i)++") "++(showLst showBool ab)++" "++(showLst showInt ai)++" "++(showLst showCol ac),[displayer s])

  displayer (EGEdge { egeCons = EGCondInt, egeLinks = EGTypeData { boolData=[c], intData=[r,t,f] }}) = displaySingle $ (showInt r) ++ " = (if " ++ (showBool c) ++" then (" ++ (showInt t) ++ ") else (" ++ (showInt f)++"))"

  displayer (EGEdge { egeCons = EGCondEqual, egeLinks = EGTypeData { boolData=[c,a,b] }}) = displaySingle $ "if " ++ (showBool c) ++" then " ++ (showBool a) ++ "=="++(showBool b)

  displayer (EGEdge { egeCons = c })  = DisplayData ("???("++(show c)++")",[])



externMap :: EGModel -> EGTypeData (Map Int EGVarId)

externMap md = foldr f (baseTypeData Map.empty) $ map snd $ Map.toList $ egmEdges md

  where f :: EGEdge -> EGTypeData (Map Int EGVarId) -> EGTypeData (Map Int EGVarId)

        f (EGEdge { egeCons = EGIntExtern i, egeLinks = EGTypeData { intData = [v] } }) st = egTypeMod EGIntType st $ \m -> Map.insert i v m

        f (EGEdge { egeCons = EGBoolExtern i, egeLinks = EGTypeData { boolData = [v] } }) st = egTypeMod EGBoolType st $ \m -> Map.insert i v m

        f (EGEdge { egeCons = EGColExtern i, egeLinks = EGTypeData { colData = [v] } }) st = egTypeMod EGColType st $ \m -> Map.insert i v m

        f _ st = st



emptyModel :: EGModel -> Bool

emptyModel mod = 

  let mm = externMap mod

      ss = Map.size (intData mm) + Map.size (colData mm) + Map.size (boolData mm)

      in ss == (Map.size $ egmEdges mod)



data EGModel = EGModel {

  egmParams :: EGTypeData Int,

  egmVars :: EGTypeData Int,

  egmNEdges :: Int,

  egmEdges :: Map EGEdgeId EGEdge,

  egmLinks :: EGTypeData (Map EGVarId [(EGEdgeId,Int)])

} deriving (Eq,Show)



filterModel :: EGModel -> (EGEdge -> Maybe a) -> (EGModel,[a])

filterModel mod f = foldl ff (mod,[]) $ Map.toList $ egmEdges mod

  where ff (mm,n) (id,ed) = 

           let res = f ed

               in case res of

                 Nothing -> (mm,n)

                 Just a -> (delEdge id mm,a:n)



prefix :: String -> DisplayData -> DisplayData

prefix s (DisplayData (s1,x)) = DisplayData (s++s1,x)



instance Display EGModel where

  displayer (EGModel { egmEdges = x }) = DisplayData ("EGModel",map (\(id,x) -> prefix ((show $ unEGEdgeId id)++": ") $ displayer x) $ Map.toList x)



addEdge :: EGConstraintSpec -> EGTypeData [EGVarId] -> EGModel -> EGModel

addEdge cons links model = 

  if (expected == getConsArgs cons)

    then

      let newEdgeId = EGEdgeId $ egmNEdges model

          in model {

               egmNEdges = egmNEdges model + 1,

               egmEdges = Map.insert newEdgeId (EGEdge { egeCons = cons, egeLinks = links }) $ egmEdges model,

               egmLinks = egTypeDataMap $ \f -> 

                 foldr (\i ->

                     Map.insertWith (++) ((f links) !! i) [(newEdgeId,i)]

                   ) (f $ egmLinks model) [0..(length (f links) - 1)]

             }

    else

      error $ "incorrect number of arguments for constraint ("++(show cons)++")"

  where expected = egTypeDataMap (\f -> length $ f links)



unifyIds :: EGVarId -> EGVarId -> EGVarId -> EGVarId

-- unifyIds fromId toId = (\x -> if x>fromId then x-1 else x) . (\x -> if x==fromId then toId else x)

unifyIds fromId toId = \x -> if x==fromId then toId else x



delEdge :: EGEdgeId -> EGModel -> EGModel

delEdge id mod = do

  let fnd = Map.lookup id $ egmEdges mod

  case fnd of

    Nothing -> error "deleting inexisting edge"

    Just ff -> do

      let nmp = Map.delete id $ egmEdges mod

          mif [] = Nothing

          mif x = Just x

          afn = mif . filter ((/=id) . fst)

          nln = egTypeDataMap $ \f -> foldr (\vid pre -> Map.alter (\(Just x) -> afn x) vid pre) (f $ egmLinks mod) $ f $ egeLinks ff

      mod { egmEdges = nmp, egmLinks = nln }



findEdge :: EGModel -> EGVarType -> EGVarId -> (Int -> Bool) -> (EGConstraintSpec -> Bool) -> Maybe (EGEdgeId,EGEdge)

findEdge model typ varid pos cons =

  let mtc1 = Map.findWithDefault [] varid $ egTypeGet typ $ egmLinks model

      mtc2 = filter (\(_,p) -> pos p) mtc1

      mtc3 = map (\(id,_) -> 

        (id,case Map.lookup id (egmEdges model) of

          Nothing -> error $ "cannot find edge id="++(show id)

          Just xx -> xx

        )) mtc2

      mtc4 = filter (\(_,s) -> cons $ egeCons s) mtc3

      in case mtc4 of

        [] -> Nothing

        a:_ -> Just a



pruneNodes :: EGModel -> EGModel

pruneNodes mod = 

  mod { egmLinks = egTypeDataMap $ \f -> Map.fromList $ filter (\(_,v) -> case v of [] -> True; _ -> False) $ Map.toList $ f $ egmLinks mod }



unifyNodes :: EGVarType -> EGVarId -> EGVarId -> EGModel -> EGModel

unifyNodes vt fromId toId model = model {

--  egmVars = egTypeMod vt (egmVars model) pred,

  egmEdges = Map.map (\x -> x {

    egeLinks = egTypeMod vt (egeLinks x) $ \z -> 

      map (unifyIds fromId toId) z

  }) $ egmEdges model,

  egmLinks = egTypeMod vt (egmLinks model) $ \x -> Map.insertWith (++) toId (Map.findWithDefault [] fromId x) x

}



addNode :: EGVarType -> EGModel -> (EGVarId,EGModel)

addNode vt model = (

    EGVarId (egTypeGet vt $ egmVars model),

    model {

      egmVars = egTypeMod vt (egmVars model) succ

    }

  )



delNode :: EGVarType -> EGVarId -> EGModel -> EGModel

delNode vt id model = model { egmLinks = egTypeMod vt (egmLinks model) (Map.delete id) }



baseGraph :: EGModel

baseGraph = EGModel {

  egmParams = baseTypeData 0,

  egmVars = baseTypeData 0,

  egmNEdges = 0,

  egmEdges = Map.empty,

  egmLinks = baseTypeData Map.empty

}



data DisplayData = DisplayData (String,[DisplayData])



class Display a where

  display :: Int -> a -> String

  displayer :: a -> DisplayData

  display n x = display n $ displayer x



present :: Display a => a -> String

present = display 0



instance Display DisplayData where

  displayer = id

  display n (DisplayData (dir,sub)) = foldl (++) ((replicate (n*2) ' ')++dir++"\n") $ map (display $ n+1) sub



displaySingle :: String -> DisplayData

displaySingle x = DisplayData (x,[])



getConnectedEdges :: EGModel -> EGVarType -> EGVarId -> [(EGEdge,Int)]

getConnectedEdges model typ id = map (\(eid,pos) -> (fromJust $ Map.lookup eid $ egmEdges model, pos)) $ fromJust $ Map.lookup id $ egTypeGet typ $ egmLinks model