{-# LANGUAGE LambdaCase #-}

module Dodge.Combine.Graph 
    ( combinationsDotGraph
    ) where

import Data.Bifunctor
import qualified Data.Graph.Inductive as FGL
import Data.GraphViz.Attributes.Complete
import Data.Text (Text)
import Data.Text.Lazy (pack, toStrict)
import Dodge.Combine.Combinations
import Dodge.Data.Item
import GraphHelp
import GraphVizHelp
import LensHelp

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

newtype CombNode = CombNode {_unCombNode :: Either ItemType [(ItAmount, ItemType)]}
    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, ItemType)], Item)]
--bulletCombinations =
--    filter
--        ( (`elem` map totype bulletWeapons)
--            . totype
--            . snd
--        )
--        itemCombinations
--  where
--    totype = _itType

maxShowX :: ItemType -> Maybe Int
maxShowX = \case
    HELD (BANGSTICK _) -> Just 2
    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 _itType) itemCombinations
  where
    --itemCombinationsEdges = concatMap (f . over _2 (_iyBase . _itType)) bulletCombinations

    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 :: ItemType -> 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)]