{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Main where

import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word32)
import Debug.Trace (trace)
--import Diagrams.Backend.SVG.CmdLine (B, mainWith)
--import Diagrams.Prelude
import GHC.Generics
import Graph.CommonGraph (Channel, CGraph, CGraphL, EdgeType (..), NodeClass (..), EdgeClass (..), UINode)
import Graph.GraphDrawing (fromAdj, layeredGraph)
import qualified Graph.IntMap as Graph
--import Graphics.SVGFonts (textSVG)

-- several papers use this graph
testGraph :: CGraph UINodeLabel UIEdgeLabel
testGraph = fromAdj (extractNodes gr) gr
  where
    gr =
      [ (0, [4, 5, 6, 20, 29], dEdge),
        (17, [3], dEdge),
        (5, [2, 3, 4, 10, 14, 26], dEdge),
        (3, [4], dEdge),
        (26, [18], dEdge),
        (14, [10], dEdge),
        (2, [8, 23], dEdge),
        (18, [13], dEdge),
        (10, [27], dEdge),
        (2, [8, 23], dEdge),
        (23, [24, 9], dEdge),
        (24, [12, 15, 28], dEdge),
        (1, [12], dEdge),
        (12, [6, 9, 19], dEdge),
        (6, [9, 13, 21, 25, 29], dEdge),
        (29, [25], dEdge),
        (21, [22], dEdge),
        (25, [11], dEdge),
        (22, [8, 9], dEdge),
        (15, [27, 16], dEdge),
        (8, [16, 20], dEdge),
        (11, [16, 9], dEdge),
        (16, [27], dEdge),
        (27, [13, 19], dEdge),
        (13, [20], dEdge),
        (19, [9], dEdge),
        (20, [4], dEdge),
        (9, [4, 28], dEdge),
        (28, [7], dEdge)
      ]

testGraph2 :: CGraph UINodeLabel UIEdgeLabel
testGraph2 = fromAdj (extractNodes gr) gr
  where
    gr =
      [ (1, [3, 4, 21, 13], dEdge),
        (2, [3, 20], dEdge),
        (3, [4, 5, 23], dEdge),
        (4, [6], dEdge),
        (5, [7], dEdge),
        (6, [8, 16, 23], dEdge),
        (7, [9], dEdge),
        (8, [10, 11], dEdge),
        (9, [12], dEdge),
        (10, [13, 14, 15], dEdge),
        (11, [15, 16], dEdge),
        (12, [20], dEdge),
        (13, [17], dEdge),
        (14, [17, 18], dEdge),
        (16, [18, 19, 20], dEdge),
        (18, [21], dEdge),
        (19, [22], dEdge),
        (21, [23], dEdge),
        (22, [23], dEdge),
        (23, [24], dEdge),
        (24, [25], dEdge),
        (26, [27], dEdge),
        (27, [28], dEdge),
        (29, [30], dEdge),
        (30, [31], dEdge),
        (32, [31], dEdge),
        (33, [31], dEdge),
        (25, [34], dEdge),
        --           (19, [26],       dEdge),
        (23, [27], vdummyEdge),
        (27, [30], vdummyEdge)
      ]

-- A typical graph of three unconnected functions with one input and output.
-- Should be displayed vertical as options
-- Vertical lines between the function nodes give an order. If the graph grows the vertical nodes should
-- still be in one column
optionsGraph :: CGraph UINodeLabel UIEdgeLabel
optionsGraph = fromAdj (extractNodes gr) gr
  where
    gr =
      [ (1, [2], dEdge),
        (2, [3], dEdge),
        (4, [5], dEdge),
        (5, [6], dEdge),
        (7, [8], dEdge),
        (8, [9], dEdge),
        (9, [10], dEdge),
        (2, [5], vdummyEdge),
        (5, [8], vdummyEdge)
      ]

dEdge :: [UIEdgeLabel]
dEdge = [standard NormalEdge]

-- [UIEdge 2 1 "" Curly "#ff5863" "" 0 False False]

vdummyEdge :: [UIEdgeLabel]
vdummyEdge = [standard VirtualHorEdge]

-- [UIEdge 2 1 "" Curly "#ff5863" "" 0 True False]
extractNodes :: EdgeClass e => [(Word32, [Word32], [e])] -> Map.Map Word32 UINodeLabel
extractNodes adj = Map.fromList (map labelNode nodes)
  where
    nodes = (map sel1 adj) ++ (concat (map sel2 adj))
    sel1 (x, y, z) = x
    sel2 (x, y, z) = y
    labelNode n =
      ( n,
        UINodeLabel
          ( FuN
              ( FunctionNode
                  ""
                  (T.pack (show n))
                  ""
              )
          )
      )

main :: IO ()
main = return () -- mainWith (visualGraph (layeredGraph True testGraph) :: Diagram B)

------------------------------------------------------------------------------------------------

data UINodeLabel = UINodeLabel
  {
    uinode :: SpecialNode [Text]
  }
  deriving (Show)

data UIEdgeLabel = UIEdgeLabel
  { lineClass :: Text,
    strokeWidth :: Maybe Int,
    opacity :: Maybe Double,
    dashArray :: Maybe Text,
    lineColor :: Maybe Text,
    lineName :: Text,
    lineType :: Maybe LineType,
    channelNrIn :: Maybe Channel, -- arg nr x of constructor node

    -- | Me, Colleague-Name to remeber past decisions, but only people you know,
    -- or company, group
    channelNrOut :: Channel, -- function output is connected with input nr x of type node
    edgeType :: EdgeType
  }
  deriving (Show)

data LineType
  = Slanted Int -- a line consisiting of slanted sublines,
  -- (a lot of people did this, but no famous)
  | Curly -- contains a several subpaths
  deriving (Show, Generic, Eq, Ord)

data SpecialNode a
  = FuN FunctionNode
  | SubN [a]
  | DN DummyNode
  | CN ConnectionNode
  | AN ArgNode
  deriving (Eq, Ord, Show, Generic)

data DummyNode = DummyNode {dsize :: Int} deriving (Eq, Ord, Show, Generic)

data ConnectionNode = ConnectionNode {size :: Int} deriving (Eq, Ord, Show, Generic)

data FunctionNode = FunctionNode
  { functionUnique :: Text,
    functionName :: Text,
    functionType :: Text -- maybe not displayed
  }
  deriving (Eq, Ord, Generic, Show)

data ArgNode = ArgNode
  { refFunctionUnique :: Text,
    argName :: Text,
    argNr :: Int,
    isValueArg :: Bool,
    isMainFunctionArg :: Bool,
    argSelected :: Bool
  }
  deriving (Eq, Ord, Show, Generic)

instance NodeClass UINodeLabel where
  isCase gr n = False
  isDummy gr n = False -- maybe False isDummyLabel (Graph.lookupNode n gr)
  isConnNode gr n = maybe False isConnLabel (Graph.lookupNode n gr)
  isFunction gr n = maybe False isFuncLabel (Graph.lookupNode n gr)
  isMainArg gr n = False -- maybe False isArgLabel (Graph.lookupNode n gr)
  isSubLabel (UINodeLabel (SubN _)) = True
  isSubLabel _ = False
  isArgLabel (UINodeLabel (AN _)) = True
  isArgLabel _ = False
  subLabels (UINodeLabel (SubN as)) = length as
  connectionNode = UINodeLabel (CN (ConnectionNode 1))
  dummyNode x = UINodeLabel (DN (DummyNode x))
  nestingFeatures _ = Nothing
  updateLayer _ n = n
  verticalNumber _ = Nothing

instance EdgeClass UIEdgeLabel where
  dummyEdge chIn chOut = UIEdgeLabel "" Nothing Nothing Nothing Nothing "" Nothing chIn chOut NormalEdge
  standard edgeType =    UIEdgeLabel "" Nothing Nothing Nothing Nothing "" Nothing Nothing 0 edgeType
  edgeType (UIEdgeLabel _ _ _ _ _ _ _ _ _ e) = e
  channelNrIn (UIEdgeLabel _ _ _ _ _ _ _ channelIn channelOut _) = channelIn
  channelNrOut (UIEdgeLabel _ _ _ _ _ _ _ channelIn channelOut _) = channelOut

isDummyLabel :: UINodeLabel -> Bool
isDummyLabel (UINodeLabel (DN _)) = True
isDummyLabel _ = False

isConnLabel :: UINodeLabel -> Bool
isConnLabel (UINodeLabel (CN _)) = True
isConnLabel _ = False

isFuncLabel :: UINodeLabel -> Bool
isFuncLabel (UINodeLabel (FuN _)) = True
isFuncLabel _ = False

isArgLabel :: UINodeLabel -> Bool
isArgLabel (UINodeLabel (AN _)) = True
isArgLabel _ = False

-----------------------------------------------------------------------------------------------

-- Using diagrams to visualise the graph (this is commented out, so that you only need the quite big diagrams dependency when using this for debugging)
{-
visualGraph :: (NodeClass n, EdgeClass e) => CGraphL n e -> Diagram B
visualGraph (g, nPositions) =
  Debug.Trace.trace (show (length shortEs) ++ " : " ++ show (length longEs) ++ show (Graph.nodes testGraph, Graph.nodes g)) $
    position graphNodes # connections shortEs
      # connectionsWithoutArrow longEs
  where
    graphNodes = catMaybes (map pos (Graph.nodes g))
    pos n = fmap (\(x, y) -> (p2 ((fromIntegral x) * 2, (fromIntegral y)), vNode (fromIntegral n))) lu
      where
        lu = Map.lookup (fromIntegral n) nPositions
    es = Graph.edges g
    shortEs = filter (\(src, tgt) -> not (isConnNode g src) && not (isConnNode g tgt)) es
    longEs = filter (\(src, tgt) -> (isConnNode g src) || (isConnNode g tgt)) es
    vNode :: Int -> Diagram B
    vNode n = visualNode (n > 31) (show n) -- (isDummyNode g (fromIntegral n)) (show n)

connections es
  | (length es) < 2 = id
  | otherwise =
    foldr1 (.) $
      map
        ( \(src, tgt) ->
            connectOutside' arrowStyle2 (show src) (show tgt)
        )
        es

connectionsWithoutArrow es
  | (length es) < 2 = id
  | otherwise =
    foldr1 (.) $
      map
        ( \(src, tgt) ->
            connectOutside' arrowStyle3 (show src) (show tgt)
        )
        es

visualNode l str
  | l -- (stateLabel str <>
    =
    dummy # named str
  | otherwise = (stateLabel str <> state) # named str

text' d s = (strokeP $ textSVG s 0.7) # lw none # fc black # center # showOrigin

stateLabel = text' 0.6

arrowLabel txt size = text' size txt

state = circle 0.4 # fc silver

dummy = circle 0.05 # fc black -- mempty

shaft = arc xDir (-1 / 6 @@ turn)

shaft' = arc xDir (-2.7 / 5 @@ turn)

line = trailFromOffsets [unitX]

arrowStyle1 =
  ( with & arrowHead .~ spike & headLength .~ small
      & arrowShaft .~ shaft
  )

arrowStyle2 =
  ( with & arrowHead .~ spike & headLength .~ small
      & arrowShaft .~ line
  )

arrowStyle3 = (with & arrowHead .~ noHead & arrowShaft .~ line) -- & shaftStyle %~ dashingG [0.1, 0.05] 0)
-}