{-# LANGUAGE MultiParamTypeClasses, Safe #-}

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

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

  Chatty 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.

  Chatty 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 Chatty. If not, see <http://www.gnu.org/licenses/>.
-}

-- | Provides a general graph.
module Data.Chatty.Graph where

import Data.Chatty.BST
import Data.Chatty.AVL
import Data.Chatty.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
  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