--{-# LANGUAGE TypeSynonymInstances #-}
--{-# LANGUAGE FlexibleInstances #-}
module Dodge.Combine.Graph where
import Dodge.Data.Item
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 [(ItAmount,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 :: [([(ItAmount,ItemBaseType)],Item)]
bulletCombinations = filter 
    ( (`elem` map totype bulletWeapons)
    . totype
    . snd
    ) itemCombinations
  where
    totype = _iyBase . _itType

maxShowX :: ItemBaseType -> Maybe Int
maxShowX bt = case bt of
    HELD (BANGSTICK _) -> Just 2
    HELD (REVOLVERX _) -> Just 1
    HELD (VOLLEYGUN _) -> Just 3
    HELD (MINIGUNX  _) -> Just 3
    HELD (GRAPECANNON _) -> Just 1
    HELD (LAUNCHERX _) -> Just 2
    HELD (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,_getItAmount 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 (_ibtHeld bt) <= i

belowNumX :: ItemBaseType -> Bool
belowNumX bt = case maxShowX bt of
    Nothing -> True
    Just i -> _xNum (_ibtHeld 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)]