{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}

{-
  This module is part of Antisplice.
  Copyleft (c) 2014 Marvin Cohrs

  All wrongs reversed. Sharing is an act of love, not crime.
  Please share Antisplice with everyone you like.

  Antisplice is free software: you can redistribute it and/or modify
  it under the terms of the GNU Affero General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.

  Antisplice is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  GNU Affero General Public License for more details.

  You should have received a copy of the GNU Affero General Public License
  along with Antisplice. If not, see <http://www.gnu.org/licenses/>.
-}

-- | Provides a general graph.
module Game.Antisplice.Utils.Graph where

import Game.Antisplice.Utils.BST
import Game.Antisplice.Utils.AVL
import Game.Antisplice.Utils.None

-- | Phantom type for a node ID
newtype NodeId = NodeId Int deriving (Eq,Show,Ord)

-- | A general graph
data Graph a b c = Graph { nodes :: AVL (Node a), edges :: [Edge b c], nextId :: NodeId }

-- | A node for the graph
data Node a = Node { nodeMarked :: Bool, nodeContent :: a, nodeId :: NodeId }

-- | An edge for the graph
data Edge b c = Edge { fromNode :: NodeId, toNode :: NodeId, weight :: Int, label :: b, content :: c }

instance Indexable (Node a) NodeId (Node a) where
  type IndexOf (Node a) = NodeId
  type ValueOf (Node a) = Node a  
  indexOf = nodeId
  valueOf = id

--instance (Show a,Show b) => Show (Graph a b) where
--  show (Graph ns es _) = unlines (map show (reverse ns) ++ map show es)
  
instance (Show a) => Show (Node a) where
  show (Node _ c i) = concat [show i, ": ", show c]

instance (Show b) => Show (Edge b c) where
  show (Edge f t w l _) = concat [show f, " --", show l, "-> ", show t, " [", show w, "]"]

-- | Increment a NodeId
incId :: NodeId -> NodeId
incId (NodeId i) = NodeId (i+1)

-- | An empty graph
emptyGraph :: Graph a b c
emptyGraph = Graph EmptyAVL [] (NodeId 0)

instance None (Graph a b c) where
  none = emptyGraph

-- | Add a node to the graph
addNode :: a -> Graph a b c -> Graph a b c
addNode x = snd . addNode' x

-- | Add a node to the graph and also return its ID
addNode' :: a -> Graph a b c -> (NodeId,Graph a b c)
addNode' x (Graph ns es nid) = (nid, Graph (avlInsert (Node False x nid) ns) es (incId nid))

-- | Add a bunch of nodes
addNodes :: [a] -> Graph a b c -> Graph a b c
addNodes xs = snd . addNodes' xs

-- | Add a bunch of nodes and also return their IDs
addNodes' :: [a] -> Graph a b c -> ([NodeId],Graph a b c)
addNodes' [] g = ([],g)
addNodes' (p:ps) g = let (ls, g'') = addNodes' ps g'
                         (l, g') = addNode' p g
                     in (l:ls, g'')

-- | Return all nodes
allNodes :: Graph a b c -> [Node a]
allNodes = avlInorder . nodes

-- | Return the node in the AVL tree's root
rootNode :: Graph a b c -> NodeId
rootNode = nodeId . avlRoot . nodes

-- | Add a unidirectional edge to the graph (provide both nodes, a weight and a label)
addEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addEdge f t w l c = addEdge' (Edge f t w l c)

-- | Add a unidirectional edge to the graph (provide the 'Edge')
addEdge' :: Edge b c -> Graph a b c -> Graph a b c
addEdge' e g = g{edges=e:edges g}

-- | Add a bidirectional edge to the graph (provide both nodes, a weight and a label)
addMutualEdge :: NodeId -> NodeId -> Int -> b -> c -> Graph a b c -> Graph a b c
addMutualEdge f t w l c = addEdge f t w l c . addEdge t f w l c

-- | Add a bunch of edges unidirectionally (provide both nodes, a weight and a label)
addEdges :: [(NodeId,NodeId,Int,b,c)] -> Graph a b c -> Graph a b c
addEdges es g = foldr (addEdge' . (\(f,t,w,l,c) -> Edge f t w l c)) g es

-- | Add a bunch of edges unidirectionally (provide the 'Edge's)
addEdges' :: [Edge b c] -> Graph a b c -> Graph a b c
addEdges' = flip $ foldr addEdge'

-- | Add a bunch of edges bidirectionally (provide both nodes, a weight and a label)
addMutualEdges :: [(NodeId,NodeId,Int,b,c)] -> Graph a b c -> Graph a b c
addMutualEdges es = addEdges es . addEdges (map (\(f,t,w,l,c) -> (t,f,w,l,c)) es)

-- | Get the node's content from its ID
getNode :: NodeId -> Graph a b c -> a
getNode n = nodeContent . getNode' n

-- | Get the 'Node' object from its ID
getNode' :: NodeId -> Graph a b c -> Node a
getNode' n = (\(Just x) -> x) . avlLookup n . nodes

-- | Set the node's content by its ID
setNode :: NodeId -> a -> Graph a b c -> Graph a b c
setNode n a g@(Graph ns _ _) = g{nodes=fmap setNode' ns}
  where setNode' (Node m c i) = if i == n then Node m a i else Node m c i

-- | Mark a node by its ID
markNode :: NodeId -> Graph a b c -> Graph a b c
markNode n g@(Graph ns _ _) = g{nodes=fmap markNode' ns}
  where markNode' (Node m c i) = if i == n then Node True c i else Node m c i 

-- | Follow an edge by its source node and label
followEdge :: Eq b => NodeId -> b -> Graph a b c -> Maybe NodeId
followEdge n l g = case filter ((==l).label) $ filter ((==n).fromNode) $ edges g of
  [] -> Nothing
  (x:_) -> Just (toNode x)

-- | Query an edge's content
queryEdge :: Eq b => NodeId -> b -> Graph a b c -> Maybe c
queryEdge n l g = case filter ((==l).label) $ filter ((==n).fromNode) $ edges g of
  [] -> Nothing
  (x:_) -> Just (content x)

-- | List all edges from the given node
listEdges :: NodeId -> Graph a b c -> [(b,c,NodeId)]
listEdges n g = fmap (\(Edge _ t _ l c) -> (l,c,t)) $ filter ((==n).fromNode) $ edges g