import Prelude
import Data.Maybe
import Data.Char (isDigit)
import Data.List ((\\), delete, sort, group)


import Eventloop.EventloopCore
import Eventloop.DefaultConfiguration
import Eventloop.Types.EventTypes

import qualified Eventloop.Module.Websocket.Canvas as C
import qualified Eventloop.Module.BasicShapes as B
import qualified Eventloop.Module.Websocket.Mouse as M
import qualified Eventloop.Module.Websocket.Keyboard as K
import qualified Eventloop.Module.StdOut as S
import Eventloop.Module.Graphs


{- | Start
This function will start the eventloop system using the eventloopConfig
-}
start = startMainloop eventloopConfig

{- | The configuration of the Eventloop system
Uses the graphs module to display graphs. This module
depends on the Keyboard, Mouse, Canvas and BasicShapes modules
-}
eventloopConfig = defaultConfig { moduleConfigurations=[ defaultGraphsModuleConfiguration
                                                       , B.defaultBasicShapesModuleConfiguration
                                                       , C.defaultCanvasModuleConfiguration
                                                       , M.defaultMouseModuleConfiguration
                                                       , K.defaultKeyboardModuleConfiguration
                                                       , S.defaultStdOutModuleConfiguration
                                                       ]}
                where
                    defaultConfig = allModulesEventloopConfiguration beginProgramState eventloop -- Uses beginProgramState and eventloop to build config


{- | ProgramState
This datatype shows which variables are kept
-}
data ProgramState
    = ProgramState { pressedKey :: [Char]
                   , node1Select :: Maybe Node
                   , node2Select :: Maybe Node
                   , graph :: Graph
                   }


{- | Begingraph
   This is the start state of the graph
-}
beginGraph = Graph allNodes allEdges Undirected Unweighted
           where
            allNodes = [ ('a', (50, 50), Red)
                       , ('b', (150, 50), Blue)
                       , ('c', (200, 200), Orange)
                       ]
            allEdges = [ ('a', 'b', Green, 5, Thick)
                       , ('c', 'b', Orange, 3, Thin)
                       , ('c', 'a', Purple, 2, Thin)
                       ]


{-| The beginstate of the ProgramState
-}
beginProgramState = ProgramState [] Nothing Nothing beginGraph


{- | Instructions
This is the list of all possible instructions
Feel free to add your own
-}
instructions = [ "Instructions"
               , "Press 'n' and click on the screen to create a new node"
               , "Press 'r', click on a node and press a letter to rename the node"
               , "Press 'e', click on two nodes to create an edge"
               , "Press 'd', click on a node to delete the node"
               , "Press 'w', click on two nodes and press a number to weight the edge in between"
               , "Press 'f', click on two nodes to delete an edge"
			   , "Press 'c', click on a node to color it red"
			   , "Press 'b', click on a node to color its neighborhood blue"
			   , "Press 'a', click on a node to reset all the coloring"
			   , "Press 'k' and select 2 nodes to check if there's a path between them."
               , "Press 'esc' to abort the current operation and start another"
               ]


{- | A variable showing which labels are used for visually added nodes
-}
automaticPossibleLabels :: [Label]
automaticPossibleLabels = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']


{- | A function to determine which label can be used next
-}
nextLabel :: [Node] -> Label
nextLabel nodes
    | null leftOverLabels = error "Did not have a leftover label to give to a node. Please do not create so many nodes!"
    | otherwise = head leftOverLabels
    where
        currentLabels = map (\(l, _, _) -> l) nodes
        leftOverLabels = automaticPossibleLabels \\ currentLabels


{- | Add a node to the graph
-}
addNode :: Graph -> Node -> Graph
addNode g@(Graph{nodes=ns}) n = g {nodes=(n:ns)}

{- returns a list of neighbours of a node -}
getNeighbors :: Graph -> Node -> [Label]
getNeighbors g@(Graph{edges=es, directed=d}) (l,_,_) = getNeighborsByEdges es l d

getNeighborsByEdges :: [Edge] -> Label -> Directed -> [Label]
getNeighborsByEdges [] n d = []
getNeighborsByEdges ((l1, l2, _, _, _):es) l Directed
		| l1 == l		 = [l2]++(getNeighborsByEdges es l Directed)
		| otherwise			 = getNeighborsByEdges es l Directed

getNeighborsByEdges ((l1, l2, _, _, _):es) l Undirected
		| l1 == l = [l2]++(getNeighborsByEdges es l Undirected)
		| l2 == l = [l1]++(getNeighborsByEdges es l Undirected)
		| otherwise = getNeighborsByEdges es l Undirected

existsPath :: Graph -> Node -> Node -> Bool
existsPath g n1 n2 = existsHelper g [n1] n2

existsHelper :: Graph -> [Node] -> Node -> Bool
existsHelper g ns n
	| elem n ns					= True
	| length ns == length ns' 	= False
	| otherwise  				= existsHelper g ns' n
		where ns' = ns ++ (getNeighborsByNodeList g ns)

getNeighborsByNodeList :: Graph -> [Node] -> [Node]
getNeighborsByNodeList _ [] = []
getNeighborsByNodeList g (n:ns) = rmdups ((getNodesByLabels g (getNeighbors g n)) ++ (getNeighborsByNodeList g ns))

{- | Paints the list of nodes to a certain colour. -}
paintItColor :: [Node] -> Color -> [Node]
paintItColor [] clr = []
paintItColor ((l,p,c):ns) clr = [(l,p,clr)]++(paintItColor ns clr)
{-
swap123to312 :: (a -> b -> c -> d) -> (b -> c -> a -> d)
swap123to312 f a b c = f c a b

existsPath :: Graph -> Node -> Node -> Bool
existsPath g@(Graph{nodes=ns, edges=es}) n1 n2
		| n1 == n2								  			= False
		| not (findEdgeFromNodeToNode n1 n2 g == Nothing) 	= True
		| findEdgesBetweenNodes n1 n2 g == []	  			= any ((swap123to312 findEdgesBetweenNodes) ((removeNodeWithAdjoiningEdges n1 g) n1)) (getNodesByLabels (getNeighbors (removeNodeWithAdjoiningEdges n1 g) n2 ))
		| otherwise								  			= True
-}
rmdups :: Eq a => [a] -> [a]
rmdups [] = []
rmdups (x:xs) 	| elem x xs = rmdups xs
				| otherwise = [x]++(rmdups xs)

{- | Gets a list of nodes by using a list of labels. -}
getNodesByLabels :: Graph -> [Label] -> [Node]
getNodesByLabels g@(Graph{nodes=ns}) labels = getNBL ns labels

getNBL :: [Node] -> [Label] -> [Node]
getNBL ns [] = []
getNBL ns (l:ls) = [getNodeByLabel ns l]++(getNBL ns ls)

getNodeByLabel :: [Node] -> Label -> Node
getNodeByLabel [] label = error "Node is not found"
getNodeByLabel ((l,a,b):ns) label 	| l == label = (l,a,b)
									| otherwise  = getNodeByLabel ns label

{- | Add an edge to the graph
-}
addEdge :: Graph -> Edge -> Graph
addEdge g@(Graph{edges=es}) e = g {edges=(e:es)}


{- | Create an edge based on two nodes
Is drawn from node1 to node2
-}
createEdge :: Node -> Node -> Edge
createEdge (l1, _, c) (l2, _, _)
    = (l1, l2, c, 0, Thin)


{- | Finds the edge directed from the first to the second node
-}
findEdgeFromNodeToNode :: Node -> Node -> Graph -> Maybe Edge
findEdgeFromNodeToNode n1 n2 g
    | null possibleEdges = Nothing
    | otherwise = Just $ head possibleEdges
    where
        allEdges = edges g
        possibleEdges = filter (edgeRunsFromNodeToNode n1 n2) allEdges


{- | Finds all edges connected to this node
-}
findEdgesAtNode :: Node -> Graph -> [Edge]
findEdgesAtNode (l, _, _) g
    = filter (\(el1, el2, _, _, _) -> el1 == l || el2 == l) allEdges
    where
        allEdges = edges g


{- | Finds all edges that are between two nodes
-}
findEdgesBetweenNodes :: Node -> Node -> Graph -> [Edge]
findEdgesBetweenNodes n1 n2 g
    = filter (edgeIsBetweenNodes n1 n2)  allEdges
    where
        allEdges = edges g


{- | Conditional to check if an edge is connected to both nodes
-}
edgeIsBetweenNodes :: Node -> Node -> Edge -> Bool
edgeIsBetweenNodes (l1, _, _) (l2, _, _) (el1, el2, _, _, _)
    = (el1 == l1 && el2 == l2) || (el1 == l2 && el2 == l1)


{- | Conditional to check if the runs is directed from the first
to the second node
-}
edgeRunsFromNodeToNode :: Node -> Node -> Edge -> Bool
edgeRunsFromNodeToNode (l1, _, _) (l2, _, _) (el1, el2, _, _, _)
    = (l1 == el1) && (l2 == el2)


{- | Removes the node from the graph
-}
removeNode :: Node -> Graph -> Graph
removeNode n g
    = g {nodes = allNodes'}
    where
        allNodes = nodes g
        allNodes' = delete n allNodes

{- | Removes the edge from the graph
-}
removeEdge :: Edge -> Graph -> Graph
removeEdge e g
    = g {edges = allEdges'}
    where
        allEdges = edges g
        allEdges' = delete e allEdges

{- | Removes a node, and all edges connected to it,
from the graph
-}
removeNodeWithAdjoiningEdges :: Node -> Graph -> Graph
removeNodeWithAdjoiningEdges n g
    = g''
    where
        g'  = removeNode n g
        g'' = foldr removeEdge g' (findEdgesAtNode n g)

{- | Rename a node in the edge to the new label
if the node is connected to that edge
-}
renameNodeInEdge :: Node -> Label -> Edge -> Edge
renameNodeInEdge (oldL, _, _) newL (el1, el2, color, weight, thickness)
    | oldL == el1 = (newL, el2, color, weight, thickness)
    | oldL == el2 = (el1, newL, color, weight, thickness)
    | otherwise   = (el1, el2, color, weight, thickness)


{- | The eventloop
This function uses the current state and an In event to determine
the new state and what changes should be made as a list of Out events.
-}
eventloop :: ProgramState -> In -> (ProgramState, [Out])

eventloop ps Start
    = (ps, [OutGraphs SetupGraphs, OutGraphs $ DrawGraph (graph ps), OutGraphs $ Instructions instructions])

eventloop ps@(ProgramState "f" (Just node1s) _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [])
    | edgeM == Nothing = (ProgramState [] Nothing Nothing g, [])
    | otherwise = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Deleted edge from '" ++ [l1] ++ "' to '" ++ [l2] ++ "'\n"])
    where
        nodeAtPosM = onNode allNodes p
        (Just nodeAtPos) = nodeAtPosM
        allNodes = nodes g
        edgeM = findEdgeFromNodeToNode node1s nodeAtPos g
        (Just edge) = edgeM
        (l1, l2, _, _, _) = edge
        g' = removeEdge edge g

{- | If 'w' has been pressed, two nodes are selected and the next key
is a digit, the edge running from node1s to node2s is weighted as that
digit
-}
eventloop ps@(ProgramState "w" (Just node1s) (Just node2s) g) (InGraphs (Key [key]))
    | isDigit key && edgeM /= Nothing = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Weighted edge from '" ++ [l1] ++ "' to '" ++ [l2] ++ "' with " ++ (show weight) ++ "\n"])
    | otherwise   = (ProgramState [] Nothing Nothing g, [])
    where
        edgeM = findEdgeFromNodeToNode node1s node2s g
        (Just edge@(l1, l2, col, w, thick)) = edgeM
        weight = read [key] :: Weight
        edge' = (l1, l2, col, weight, thick)
        g' =  (flip addEdge) edge' $ removeEdge edge g

{- | color the selected node red -}
eventloop ps@(ProgramState "c" _ _ g) (InGraphs (Mouse (Click _) pos))
	| 	nodeAtPosM 	== Nothing = (ps, [])
	|	otherwise 			   = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Colored node " ++ [l] ++ " red.\n"])
	where
		nodeAtPosM = onNode allNodes pos
		(Just nodeAtPos) = nodeAtPosM
		(l, p, _) = nodeAtPos
		newNode = (l, p, Red)
		allNodes = nodes g
		g' = addNode (removeNode nodeAtPos g) newNode

{- | color the neighbourhood blue -}
eventloop ps@(ProgramState "b" _ _ g) (InGraphs (Mouse (Click _) pos))
	| 	nodeAtPosM 	== Nothing = (ps, [])
	|	otherwise 			   = (ProgramState [] Nothing Nothing g'', [OutGraphs $ DrawGraph g'', OutStdOut $ S.StdOutMessage $ "Colored the neighborhood of " ++ [l] ++ " blue.\n"])
	where
		nodeAtPosM = onNode allNodes pos
		(Just nodeAtPos) = nodeAtPosM
		(l, p, c) = nodeAtPos
		nbs = getNeighbors g nodeAtPos
		nbsNew = paintItColor (getNodesByLabels g nbs) Blue
		allNodes = nodes g
		g' = foldl (flip removeNode) g (getNodesByLabels g nbs)
		g'' = foldl addNode g' nbsNew


{- | color everything back to normal -}
eventloop ps@(ProgramState "a" _ _ g) (InGraphs (Mouse (Click _) pos))
	| 	nodeAtPosM 	== Nothing = (ps, [])
	|	otherwise 			   = (ProgramState [] Nothing Nothing g'', [OutGraphs $ DrawGraph g'', OutStdOut $ S.StdOutMessage $ "Reset the coloring.\n"])
	where
		nodeAtPosM = onNode allNodes pos
		(Just nodeAtPos) = nodeAtPosM
		(l, p, c) = nodeAtPos
		nodesNew = paintItColor allNodes Orange
		allNodes = nodes g
		g' = foldl (flip removeNode) g (allNodes)
		g'' = foldl addNode g' nodesNew


{- | If 'd' has been pressed and a node is selected
, the node is deleted from the graph
-}
eventloop ps@(ProgramState "d" _ _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [])
    | otherwise = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Deleted node '" ++ [l] ++ "'\n"])
    where
        (l, _, _) = nodeAtPos
        nodeAtPosM = onNode allNodes p
        (Just nodeAtPos) = nodeAtPosM
        allNodes = nodes g
        g' = removeNodeWithAdjoiningEdges nodeAtPos g


{- | If 'e' has been pressed, a node selected and a new node is selected
an edge is drawn between the two nodes
-}
eventloop ps@(ProgramState "e" (Just node1s) _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [])
    | otherwise = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Created edge from '" ++ [l1] ++ "' to '" ++ [l2] ++ "'\n"])
    where
        (l1, _, _) = node1s
        (l2, _, _) = nodeAtPos
        nodeAtPosM = onNode allNodes p
        allNodes = nodes g
        (Just nodeAtPos) = nodeAtPosM
        g' = addEdge g $ createEdge node1s nodeAtPos

{- | If 'k' has been pressed, a node selected and a new node is selected
an edge is drawn between the two nodes
-}
eventloop ps@(ProgramState "k" (Just node1s) _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [])
    | otherwise = (ProgramState [] Nothing Nothing g, [OutGraphs $ DrawGraph g, OutStdOut $ S.StdOutMessage $ "Edge from '" ++ [l1] ++ "to " ++ [l2] ++ "'exists:  '" ++ (show hasPath) ++ ".'\n"])
    where
        (l1, _, _) = node1s
        (l2, _, _) = nodeAtPos
        nodeAtPosM = onNode allNodes p
        allNodes = nodes g
        (Just nodeAtPos) = nodeAtPosM
        hasPath = existsPath g node1s nodeAtPos

{- | If 'r' has been pressed, a node selected and a new key stroke
comes in, the label of the selected node is changed
-}
eventloop ps@(ProgramState "r" (Just node1s) _ g) (InGraphs (Key [l]))
    = (ProgramState [] Nothing Nothing g'', [OutGraphs $ DrawGraph g'', OutStdOut $ S.StdOutMessage $ "Renamed node '" ++ [oldL] ++ "' to '" ++ [l] ++ "'\n"])
    where
        allNodes = nodes g
        allEdges = edges g
        (oldL, p, color) = node1s
        node' = (l, p, color)
        allEdges' = map (renameNodeInEdge node1s l) allEdges :: [Edge]
        g'  = (flip addNode) node' $ removeNode node1s g
        g'' = g' {edges = allEdges'}


{- | If 'n' has been pressed and the mouse has
clicked at a position where there is no node yet,
a new node is inserted at that point
-}
eventloop ps@(ProgramState "n" _ _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ProgramState [] Nothing Nothing g', [OutGraphs $ DrawGraph g', OutStdOut $ S.StdOutMessage $ "Inserted node '" ++ [nextlabel] ++ "'\n"])
    | otherwise             = (ps, [OutStdOut $ S.StdOutMessage "Tried to insert a node on another node"])
    where
        nodeAtPosM = onNode allNodes p
        allNodes = nodes g
        nextlabel = nextLabel allNodes
        newNode = (nextlabel, p, Orange)
        g' = g {nodes=(newNode:allNodes)}


{- | Buffer the last node selected if it doesn't
trigger an event on first spot
-}
eventloop ps@(ProgramState _ Nothing _ g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [])
    | otherwise             = (ps {node1Select = Just nodeAtPos}, [OutStdOut $ S.StdOutMessage $ "[1st Select] Click on node '" ++ [l] ++ "'\n"])
    where
        (l, _, _) = nodeAtPos
        (Just nodeAtPos) = nodeAtPosM
        nodeAtPosM = onNode allNodes p
        allNodes = nodes g


{- | Buffer the last node selected if it doesn't trigger an event on second spot -}
eventloop ps@(ProgramState _ (Just _) Nothing g) (InGraphs (Mouse (Click _) p))
    | nodeAtPosM == Nothing = (ps, [OutStdOut $ S.StdOutMessage "Clicked on not a node\n"])
    | otherwise             = (ps {node2Select = Just nodeAtPos}, [OutStdOut $ S.StdOutMessage $ "[2nd Select] Click on node '" ++ [l] ++ "'\n"])
    where
        (l, _, _) = nodeAtPos
        (Just nodeAtPos) = nodeAtPosM
        nodeAtPosM = onNode allNodes p
        allNodes = nodes g


{- | Abort current operation and reset start on "esc" -}
eventloop ps (InGraphs (Key "esc"))
    = (ProgramState [] Nothing Nothing (graph ps), [OutStdOut $ S.StdOutMessage "Aborted current operation\n"])


{- | Stop the system on "s" -}
eventloop ps (InGraphs (Key "s"))
    = (ps, [OutStdOut $ S.StdOutMessage "Stopping system...\n", Stop])


{- | Buffer the last press key if it doesn't trigger an event -}
eventloop ps@(ProgramState _ _ _ _) (InGraphs (Key key))
    = (ps {pressedKey = key}, [OutStdOut $ S.StdOutMessage $ "Buffered keystroke '" ++ key ++ "'\n" ])


{- | For all other In events, do nothing -}
eventloop ps _ = (ps, [])