module Sifflet.Data.WGraph 
    (WNode(..), WEdge(..), WGraph, wgraphNew, grInsertNode, grRemoveNode
    , connectToFrame
    , grConnect, grDisconnect
    , grAddGraph
    , grExtractExprTree, grExtractLayoutNode, grExtractLayoutTree
     
    , wlab, llab, nodeExprNode, nodeText, nodeValue
    , nodeBBox, nodePosition, nodeInputValues
    , nodeAllChildren, nodeSimpleChildren, nodeFrameChildren
    , nodeAllSimpleDescendants, nodeProperSimpleDescendants
    , nodeIsSimple, nodeIsOpen, nodeContainerFrameNode
    , nodeParent

    , grUpdateFLayout, grUpdateTreeLayout
    , translateNodes
    , translateNode, grRelabelNode
    , translateTree
    , functoidParts, functionToParts
    )

where 

import Data.List (sort)
import Data.Maybe (fromJust)

import Data.Graph.Inductive as G

import Sifflet.Data.Functoid
import Sifflet.Data.Geometry
import Sifflet.Data.Tree as T    -- exports Data.Tree.Tree(Node), etc.
import Sifflet.Data.TreeLayout
import Sifflet.Language.Expr
import Sifflet.Text.Repr ()
import Sifflet.Util

-- | A WGraph consists of WNodes with (sort of) Int-labled edges;
-- the edge labels serve to order the children of a node.

type WGraph = Gr WNode WEdge

data WEdge = WEdge Int
           deriving (Eq, Read, Show)

instance Ord WEdge where
  compare (WEdge i) (WEdge j) = compare i j

-- | Two kinds of WNodes:
-- A WSimple node represents a node in an expression tree, e.g., "if", "+"
-- A WFrame node represents a panel or frame that displays an expression tree,
-- function call, or something similar.

data WNode = WSimple (LayoutNode ExprNode) 
           | WFrame G.Node
             deriving (Eq, Show)

instance Repr WNode where
    repr (WSimple lnode) = repr (gnodeValue (nodeGNode lnode))
    repr (WFrame _) = "<frame>"

wgraphNew :: WGraph
wgraphNew = empty

-- | Insert new node with given label into graph,
-- without any new edges;
-- return the new graph and the new node (number)
grInsertNode :: (DynGraph g) => g n e -> n -> (g n e, G.Node)
grInsertNode graph label =
    let (_, hi) = nodeRange graph
        newNode = succ hi
        nodeContext = ([], newNode, label, [])
        graph' = nodeContext & graph
    in (graph', newNode)

-- | Remove a node from the graph; return the updated graph.
grRemoveNode :: (DynGraph g) => g n e -> G.Node -> (g n e)
grRemoveNode graph node = 
    let (mctx, g') = match node graph
    in case mctx of
         Nothing -> errcats ["grRemoveNode: node not found:", show node]
         Just _ -> g'

-- | Connect parent to child, using inlet as the order of the child
-- (0, 1, ...).  outlet is ignored, since there is only outlet 0.
-- As rendered, the parent's inlet-th inlet will have a line
-- to the child's outlet-th outlet.
-- This is achieved by inserting a labeled edge (parent, child, inlet)
-- and clearing any incompatible edge.  The incompatibles are:
-- a.  from same parent on same inlet to a different child.
-- b.  from the same parent on a different inlet to the same child.
-- c.  from same child (on same outlet) to a different parent.
--
-- NOTE: This is confusing, because, from the data flow perspective,
-- data flows OUT of the child INTO the parent, but from the
-- "tree in graph" perspective, links are directed OUT of the parent
-- INTO the child.  So beware!

grConnect :: WGraph -> G.Node -> WEdge -> G.Node -> WEdge -> WGraph
grConnect g parent inlet child _outlet =
    let (mPcontext, g') = match parent g
    in case mPcontext of
      Nothing -> error "grConnect: parent not found"
      -- should parent below be same as parent above?
      Just (pins, jparent, plabel, pouts) ->
          -- jparent == parent
          let pouts' = filter (edgeNotTo child)
                              (filter (edgeNotEqual inlet) pouts)
              (mCcontext, g'') = match child g'
          in case mCcontext of
               Nothing -> error "grConnect: child not found"
               Just (_cins, jchild, clabel, couts) ->
                   -- jchild == child
                   -- remove ANY  links into the jchild (c)
                   let cins' = []
                   in                    
                     (pins, jparent, plabel, (inlet, jchild) : pouts') & 
                     ((cins', jchild, clabel, couts) & g'')

edgeNotEqual :: WEdge -> (WEdge, G.Node) -> Bool
edgeNotEqual edge pair = edge /= fst pair

edgeNotTo :: G.Node -> (WEdge, G.Node) -> Bool
edgeNotTo node pair = node /= snd pair

-- | Removes a link between parent and child
-- where the edge was labeled inlet (order of child).
-- Ignores outlet, which should always be 0.
-- If child is not the inlet-th child of parent,
-- well, this is an error, but grDisconnect ignores it.
-- If toFrameP is true, the child node is
-- reconnected as a child to its frame
grDisconnect :: WGraph -> G.Node -> WEdge -> G.Node -> WEdge -> Bool -> WGraph
grDisconnect g parent inlet child _outlet toFrameP =
    let (mcontext, g') = match parent g
        g'' = case mcontext of
                Nothing -> error "grDisconnect: parent not found"
                Just (ins, jparent, label, outs) ->
                    -- jparent == parent
                    let outs' = filter (/= (inlet, child)) outs
                    in (ins, jparent, label, outs') & g'
    in if toFrameP
       then connectToFrame child (nodeContainerFrameNode g parent) g''
       else g''

connectToFrame :: G.Node -> G.Node -> WGraph -> WGraph
connectToFrame child frameNode g =
    insEdge (frameNode, child, WEdge (outdeg g frameNode)) g

grAddGraph :: (DynGraph g) => g n e -> g n e -> g n e
grAddGraph g1 g2 =
    let (_, hi1) = nodeRange g1
        (lo2, _) = nodeRange g2
        diff = hi1 - lo2 + 1

        adjIncr :: Adj e -> Adj e
        adjIncr adj = [(x, node + diff) | (x, node) <- adj]

        ctxIncr :: Context n e -> Context n e
        ctxIncr (adjFrom, node, label, adjTo) = 
            (adjIncr adjFrom, node + diff, label, adjIncr adjTo)

        loop :: (DynGraph g) => g n e -> g n e -> g n e
        loop ga gb =
            if isEmpty gb
            then ga
            else let (acontext, gb') = matchAny gb in
                 ctxIncr acontext & loop ga gb'
    in loop g1 g2

-- | Extract from a graph the expression with root node n, 
-- returning a Tree of ExprNode.
-- Use only the WSimple nodes of the graph (and n had better be one).
grExtractExprTree :: WGraph -> G.Node -> Tree ExprNode
grExtractExprTree g = fmap layoutNodeSource . grExtractLayoutTree g

-- ------------------------------------------------------------
-- | Finding characteristics of the WNodes in a graph
-- It is an implicit error if there is no label for the node

-- | wlab is like lab with no Maybe: the node *must* have a label
wlab :: WGraph -> Node -> WNode
wlab g n = fromJust (lab g n)

-- | llab is the tree layout node of a WSimple node
llab :: WGraph -> Node -> LayoutNode ExprNode
llab g n = 
    case wlab g n of
      WSimple lnode -> lnode
      WFrame _fnode ->
          errcat ["llab: node is not simple",
                  "\nnode ", (show n),
                  "\n in graph\n",
                  (show g)]

-- | The ExprNode represented by the graph node
nodeExprNode :: WGraph -> Node -> ExprNode
nodeExprNode g n = gnodeValue (nodeGNode (llab g n))

-- | The repr of the node's value
nodeText :: WGraph -> Node -> String
nodeText g n = tbText (head (gnodeTextBoxes (nodeGNode (llab g n))))

-- | The result of an evaluated node in an expression tree
nodeValue :: WGraph -> Node -> EvalResult
nodeValue g n = mvalue
    where ENode _ mvalue = nodeExprNode g n

-- | The node's BBox
nodeBBox :: WGraph -> Node -> BBox
nodeBBox g n = gnodeNodeBB (nodeGNode (llab g n))

nodePosition :: WGraph -> Node -> Position
nodePosition g = bbPosition . nodeBBox g

nodeInputValues :: WGraph -> Node -> EvalResult
nodeInputValues graph node = 
   mapM (nodeValue graph) (nodeSimpleChildren graph node) >>= 
   EvalOk . VList
  
-- | Finding the children (nodes, numbers) of a node in a graph :
-- all children, only WSimple-labeled children, only WFrame-labeled children
-- When constructing the graph, ordered children of a tree node 
-- get graph node numbers in ascending order; therefore,
-- sorting the graph nodes gives back the original order of
-- children in the tree (plus WFrames that are added later,
-- and those should always be after the simple children)

nodeAllChildren :: WGraph -> Node -> [Node]
nodeAllChildren g n = sort (suc g n) 

nodeSimpleChildren :: WGraph -> Node -> [Node]
nodeSimpleChildren g n = filter (nodeIsSimple g) (nodeAllChildren g n)

nodeAllSimpleDescendants :: WGraph -> Node -> [Node]
nodeAllSimpleDescendants g n = 
    n : concatMap (nodeAllSimpleDescendants g) (nodeSimpleChildren g n)

nodeProperSimpleDescendants :: WGraph -> Node -> [Node]
nodeProperSimpleDescendants g n = tail (nodeAllSimpleDescendants g n)

nodeFrameChildren :: WGraph -> Node -> [Node]
nodeFrameChildren g n = filter (not . nodeIsSimple g) (nodeAllChildren g n)
    
nodeIsSimple :: WGraph -> Node -> Bool
nodeIsSimple g n = 
    -- is node n of graph g a WSimple node?
    case lab g n of
      Just (WSimple _) -> True
      _ -> False

-- | An open node has a WFrame-labeled child
nodeIsOpen :: WGraph -> Node -> Bool
nodeIsOpen graph node = nodeFrameChildren graph node /= []

-- The root node of the tree in which node occurs.
-- This is a WSimple node, it may not back up to a WFrame node.
--
-- THIS CODE IS UNTESTED, AND CURRENTLY UNUSED (2009/2/4)

-- -- nodeTreeRoot: unused
-- nodeTreeRoot :: WGraph -> Node -> Node
-- nodeTreeRoot g n = findRoot n
--     where findRoot node = 
--               case pre g node of
--                 [] -> (error "nodeTreeRoot: no simple root found")
--                 [parent] -> 
--                     if not (nodeIsSimple g parent)
--                     then node
--                     else findRoot parent
--                 _ -> error "nodeTreeRoot: node has multiple parents"

-- -- The root (a WSimple node) of the tree in which a node occurs
-- -- Huh, don't need this!

-- -- nodeSimpleRoot: unused
-- nodeSimpleRoot :: WGraph -> Node -> Node
-- nodeSimpleRoot = undefined

-- | The graph node of the frame that contains the given node
nodeContainerFrameNode :: WGraph -> Node -> Node
nodeContainerFrameNode g n = 
    let findFrame node =
            if not (nodeIsSimple g node)
            then node
            else case pre g node of
                   [parent] -> findFrame parent
                   [] -> err "has no parent but is not a frame node" node
                   _:_ -> err "has multiple parents" node
        err msg node =
            errcat["nodeContainerFrameNode: node ",
                   show node, " ", msg, "\n",
                   "in graph\n", show g]
        
    in findFrame n

-- | The parent (if any) of a node
nodeParent :: WGraph -> Node -> Maybe Node
nodeParent g n = 
    case pre g n of
      [] -> Nothing
      [parent] -> Just parent
      _ -> error "nodeParent: multiple parents"


grUpdateFLayout :: WGraph -> [G.Node] -> FunctoidLayout -> WGraph
grUpdateFLayout gr ns tlo =
    case tlo of
      FLayoutTree t -> 
          case ns of
            [rootNode] -> grUpdateTreeLayout gr rootNode t
            _ -> error "grUpdateFLayout: tree tlo, but not a single root"
      FLayoutForest f _b ->
          let accum g (n, t) = grUpdateTreeLayout g n t
          in foldl accum gr (zip ns f)

-- | Replace the tree embedded in graph g with root n, with a new tree.
grUpdateTreeLayout :: WGraph -> G.Node -> TreeLayout ExprNode -> WGraph
grUpdateTreeLayout gr n0 t0 = updateTree gr n0 t0
    where updateTree g n (T.Node root subtrees) =
              case match n g of
                (Just (adjFrom, jn, WSimple _, adjTo), g1) ->
                    -- jn == n
                    let g2 = (adjFrom, jn, WSimple root, adjTo) & g1
                    in updateForest g2 (nodeSimpleChildren g jn) subtrees
                (Just (_adjFrom, _n, _, _adjTo), _) ->
                    error "grUpdateTreeLayout: root node is not a WSimple"
                (Nothing, _) -> 
                    errcats ["grUpdateTreeLayout: no such node:", show n]

          updateForest g [] [] = g
          updateForest g (n:ns) (t:ts) = 
              case lab g n of
                Just (WSimple _) -> updateForest (updateTree g n t) ns ts
                Just (WFrame _) -> updateForest g ns (t:ts) -- shouldn't happen!
                Nothing -> error "grUpdateTreeLayout: no label for node"

          updateForest _g _ [] = error "too many ns"
          updateForest _g [] _ = error "too many ts"

-- | Extract just the single tree layout node of the given graph node
grExtractLayoutNode :: WGraph -> G.Node -> LayoutNode ExprNode
grExtractLayoutNode g n =
    case lab g n of
      Just (WSimple lnode) -> lnode
      _ -> errcats ["grExtractLayoutNode:",
                    "no label for node, or node is not WSimple:",
                    "node", show n]

-- | Extract the tree layout (tree) descended from the given root node
grExtractLayoutTree :: WGraph -> G.Node -> TreeLayout ExprNode
grExtractLayoutTree g n =
    T.Node (grExtractLayoutNode g n)
           (map (grExtractLayoutTree g) (nodeSimpleChildren g n))


-- | Translate the nodes forming a tree with the given root
translateTree :: Double -> Double -> WGraph -> G.Node -> WGraph
translateTree dx dy wgraph root = 
    grUpdateTreeLayout wgraph root 
                   (translate dx dy (grExtractLayoutTree wgraph root))


translateNodes :: Double -> Double -> WGraph -> [G.Node] -> WGraph
translateNodes dx dy = foldl (translateNode dx dy)

translateNode :: Double -> Double -> WGraph -> G.Node -> WGraph
translateNode dx dy wg node =
    case match node wg of
      (Nothing, _) ->
          errcats ["translateNode: no such node:", show node]
      (Just (adjFrom, jnode, WSimple layoutNode, adjTo), g') ->
          -- jnode == node
          (adjFrom, jnode, WSimple (translate dx dy layoutNode), adjTo) & g'
      (Just _, _) ->
          errcats ["translateNode: node is not a WSimple:", show node]


-- | Replace the label of a node in a graph
grRelabelNode :: (DynGraph g) => g a b -> G.Node -> a -> g a b
grRelabelNode g n newLabel =
    case match n g of
      (Just (adjFrom, jn, _oldLabel, adjTo), g') ->
          -- jn == n
          (adjFrom, jn, newLabel, adjTo) & g'
      (Nothing, _) -> errcats ["grRelabelNode: no such node:", show n]

-- | Get the parts of a Functoid.
-- See note on functionToParts (just below).
-- Seems to be unused ***

functoidParts :: Functoid -> WGraph -> G.Node -> Functoid
functoidParts functoid graph frameNode =
    case functoid of
      fp@FunctoidParts {} -> fp
      FunctoidFunc function -> functionToParts function graph frameNode

-- | Convert a function to its parts.
-- COULDN'T THIS BE DONE USING the function's implementation,
-- and not need to use the graph?  Then this could go in Functoid.hs
-- without circular import between it and WGraph
functionToParts :: Function -> WGraph -> G.Node -> Functoid
functionToParts (Function mname _atypes _rtype impl) graph frameNode  =
    case impl of 
      Primitive _ -> error "functionToParts: function is primitive"
      Compound argnames _body ->
          FunctoidParts {fpName = case mname of
                                    Nothing -> "unnamed function"
                                    Just jname -> jname,
                         fpArgs = argnames, 
                         fpNodes = nodeProperSimpleDescendants graph frameNode}