--{-# LANGUAGE TypeSynonymInstances #-}
--{-# LANGUAGE FlexibleInstances #-}
module Dodge.Combine.Graph where
import Dodge.Data hiding (East,West,North,South)
import Dodge.Combine.Combinations
import LensHelp
import GraphHelp

import Data.Text (Text)
import Data.Text.Lazy (toStrict,pack)
import qualified Data.Graph.Inductive as FGL
import GraphVizHelp
import Data.GraphViz.Attributes.Complete
import Data.Bifunctor

data CombClust
    = CraftClust
    | ItemClust
    | JoinClust
  deriving (Eq,Ord,Show,Enum,Bounded)

newtype CombNode = CombNode {_unCombNode :: Either ItemBaseType [(IcAmount,ItemBaseType)]}
  deriving (Eq,Ord,Show)

instance Labellable CombNode where
    toLabelValue (CombNode Right{}) = StrLabel (pack "")
    toLabelValue (CombNode (Left ibt)) = StrLabel (pack $ show ibt)

newtype CombEdge = CombEdge {_unCombEdge :: Int}
  deriving (Eq,Ord,Show)
instance Labellable CombEdge where
    toLabelValue (CombEdge 0) = StrLabel (pack "")
    toLabelValue (CombEdge x) = StrLabel (pack $ show x)

bulletCombinations :: [([(IcAmount,ItemBaseType)],Item)]
bulletCombinations = filter 
    ( (`elem` map totype bulletWeapons)
    . totype
    . snd
    ) itemCombinations
  where
    totype = _iyBase . _itType

maxShowX :: ItemBaseType -> Maybe Int
maxShowX bt = case bt of
    BANGSTICK _ -> Just 2
    REVOLVERX _ -> Just 1
    VOLLEYGUN _ -> Just 3
    MINIGUNX  _ -> Just 3
    GRAPECANNON _ -> Just 1
    LAUNCHERX _ -> Just 2
    LASWIDE _ -> Just 2
--    LASGUNFOCUS _ -> Just 2
    _ -> Nothing

itemCombinationsEdges :: [(CombNode,CombNode,Int)]
itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) itemCombinations
--itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations
  where
    f (abts,bt) 
        | bt `elem` bts = []
        | (not . all belowNumX) bts = []
        | otherwise =  (CombNode $ Right abts,CombNode $  Left bt,0) :  map g abts
      where
        bts = map snd abts
        g (am,bt') = (CombNode $ Left bt',CombNode $ Right abts,_toInt am)

combinationsGraph :: FGL.Gr CombNode CombEdge
combinationsGraph = FGL.labnfilter (f . _unCombNode . snd) 
    . second CombEdge $ mkGraphFromEdges itemCombinationsEdges
  where
    f Right {} = True
    f (Left (CRAFT _)) = False
    f (Left bt) = case maxShowX bt of
        Nothing -> True
        Just i -> _xNum bt <= i

belowNumX :: ItemBaseType -> Bool
belowNumX bt = case maxShowX bt of
    Nothing -> True
    Just i -> _xNum bt <= i

toCombNodeLabel :: CombNode -> String
toCombNodeLabel (CombNode (Left ibt)) = show ibt
toCombNodeLabel (CombNode Right{}) = ""

combinationsDotGraph :: Text
--combinationsDotGraph = toStrict . printDotGraph . graphToDot nonClusteredParams $ combinationsGraph
combinationsDotGraph = toStrict . printDotGraph . graphToDot myParams 
    $ combinationsGraph
--    $ first toCombNodeLabel combinationsGraph

myParams :: GraphvizParams Int CombNode CombEdge CombClust CombNode
myParams = defaultParams -- {globalAttributes = [GraphAttrs [RankDir FromLeft]]}
    & isDirectedL .~ True
--    & globalAttributesL .~ [GraphAttrs [RankDir FromLeft,Splines PolyLine]]
    & globalAttributesL .~ [GraphAttrs [RankDir FromLeft]]
    & clusterByL .~ clusterFunc
    & isDotClusterL .~ const False
    & clusterIDL .~ setClusterID
    & fmtClusterL .~ clusterFormatting
    & fmtEdgeL .~ edgeFormatting
    & fmtNodeL .~ nodeFormatting

setClusterID :: CombClust -> GraphID
setClusterID = Num . Int . fromEnum

clusterFunc :: (Int,CombNode) -> NodeCluster CombClust (Int,CombNode)
clusterFunc n@(_,CombNode (Left bt)) = case bt of
    CRAFT _ -> C CraftClust (N n)
    _ -> C ItemClust (N n)
clusterFunc n = C JoinClust (N n)

clusterFormatting :: CombClust -> [GlobalAttributes]
clusterFormatting cl = case cl of
--    CraftClust -> [GraphAttrs [Rank SameRank]]
    CraftClust -> []
    _ -> []

edgeFormatting :: (Int,Int,CombEdge) -> Attributes
--edgeFormatting (_,_,CombEdge 0) = []
--     [ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)])
--    ,SameTail (pack "b")
--    ]
edgeFormatting (_,_,ce) = case _unCombEdge ce of
    0 -> [ xLabel ce
        , TailPort (CompassPoint East)
        ]
    _ -> [ xLabel ce
        , ArrowHead (AType [(ArrMod OpenArrow BothSides ,NoArrow)])
        , HeadPort (CompassPoint West)
        ]


nodeFormatting :: (Int,CombNode) -> Attributes
nodeFormatting (_,CombNode Right {}) = [Shape PointShape]
nodeFormatting (_,CombNode cn@(Left bt)) = case bt of
    --CRAFT _ -> [Shape DiamondShape,toLabel (CombNode cn)]
    CRAFT _ -> [Color [WC (X11Color Green) Nothing],toLabel (CombNode cn)]
    _ -> [Shape BoxShape,toLabel (CombNode cn)]