module Dodge.Item.Grammar (
    invLDT,
    invAdj,
    invRootMap,
    invRootTrees,
    baseCI,
    allInvLocs,
) where

import Dodge.Item.MagAmmoType
import Dodge.Data.AmmoType
import Dodge.Item.AmmoSlots
import Dodge.Data.TriggerType
import Dodge.BaseTriggerType
import Dodge.Data.AimStance
import Dodge.Item.AimStance
import Control.Applicative
import qualified Data.IntMap.Strict as IM
import Data.Maybe
import qualified Data.Set as S
import Dodge.Data.ComposedItem
import Dodge.Data.DoubleTree
import Dodge.Data.Item
import Dodge.DoubleTree
import Dodge.Item.Orientation
import LensHelp
import ListHelp

tryAttachItems ::
    LabelDoubleTree ItemLink ComposedItem ->
    LabelDoubleTree ItemLink ComposedItem ->
    Maybe (LabelDoubleTree ItemLink ComposedItem)
tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine

useBreakL ::
    [(ItemStructuralFunction, ComposeLinkType)] ->
    [(ItemStructuralFunction, ComposeLinkType)] ->
    LinkTest
useBreakL x y = useBreakListsLinkTest (map (uncurry noa) x) (map (uncurry noa) y)
  where
    noa a b = (a, ILink b orientAttachment)

useBreakListsLinkTest ::
    [(ItemStructuralFunction, ItemLink)] ->
    [(ItemStructuralFunction, ItemLink)] ->
    LinkTest
useBreakListsLinkTest llist rlist = LTest ltest rtest
  where
    ltest ldt = do
        let xs =
                dropWhile
                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                    llist
        (sf, linktype) <- safeHead xs
        return $ LUpdate linktype (set _3 (useBreakListsLinkTest (tail xs) rlist)) 
            (_2 .~ sf)
    rtest ldt = do
        let xs =
                dropWhile
                    ((\s -> not $ S.member s (structureToPotentialFunction ldt)) . fst)
                    rlist
        (sf, linktype) <- safeHead xs
        return $ LUpdate linktype (set _3 (useBreakListsLinkTest llist (tail xs))) 
            (_2 .~ sf)

itemToBreakLists ::
    Item ->
    ItemStructuralFunction ->
    ([(ItemStructuralFunction, ComposeLinkType)], [(ItemStructuralFunction, ComposeLinkType)])
itemToBreakLists itm itmf = case (itm ^. itType, itmf) of
    (HELD TORCH, _) -> (getAmmoLinks itm, [])
    (ATTACH UNDERBARRELSLOT, _) -> ([(UnderBarrelPlatformSF, UnderBarrelPlatformLink)], [])
    (_, HeldPlatformSF) ->
        ( getAmmoLinks itm
            <> extraWeaponLinksBelow itm
        , [(WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
            <> getAutoSpringLinks itm
            <> extraWeaponLinks itm
        )
    (DETECTOR {}, _) -> 
        ( getAmmoLinks itm
        , [(ARHUDSF,SFLink ARHUDSF),(TriggerSF, TriggerLink),(MapperSF,SFLink MapperSF)]
        )
    (MAPPER, _) -> 
        ( []
        , [(ARHUDSF,SFLink ARHUDSF)]
        )
    (_, GadgetPlatformSF) ->
        ( getAmmoLinks itm
        , [(TriggerSF, TriggerLink), (WeaponTargetingSF, WeaponTargetingLink), (WeaponScopeSF, WeaponScopeLink)]
        )
    (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do
        atype <- magAmmoType itm
        let screenanddet = case atype of
                LauncherAmmo ->
                    [ (RemoteScreenSF, RemoteScreenLink)
                    , (RemoteDetonatorSF, RemoteDetonatorLink)
                    ]
                _ -> []
        return
            ( [ (AmmoModifierSF atype, AmmoModLink)
              , (AmmoTargetingSF atype, AmmoTargetingLink)
              , (AmmoPayloadSF atype, AmmoPayloadLink)
              , (AmmoEffectSF atype, AmmoEffectLink)
              , (SmokeReducerSF, SmokeReducerLink)
              ]
                <> screenanddet
            , []
            )
    (_, RemoteScreenSF) ->
        ( [(JoystickSF, JoystickLink)]
        , []
        )
    (_, WeaponTargetingSF) -> (getAmmoLinks itm ++ [(ARHUDSF, SFLink ARHUDSF)], [])
    (ATTACH BULLETSYNTH, _) ->
        ([(AmmoMagSF ElectricalAmmo, AmmoInLink 0 ElectricalAmmo)], [])
    _ -> ([], [])

getAutoSpringLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
getAutoSpringLinks itm = case baseTriggerType itm of
    HammerTrigger -> [(MakeAutoSF, MakeAutoLink)]
    _ -> []

extraWeaponLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
extraWeaponLinks itm = case itm ^. itType of
    HELD GLAUNCHER -> launcherlinks <> [(GrenadeHitEffectSF,GrenadeHitEffectLink)]
    HELD RLAUNCHER -> launcherlinks
    HELD RLAUNCHERX{} -> launcherlinks
    _ -> []
  where
    launcherlinks = [(ProjectileStabiliserSF,ProjectileStabiliserLink)]

extraWeaponLinksBelow :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
extraWeaponLinksBelow itm
--    | Just TwoHandUnder <- itm ^? itUse . heldAim . aimStance
    | TwoHandUnder <- aStance itm
        = [(UnderBarrelSlotSF,UnderBarrelSlotLink)]
    | otherwise = []

getAmmoLinks :: Item -> [(ItemStructuralFunction, ComposeLinkType)]
getAmmoLinks itm =
    map
        (\(i, a) -> (AmmoMagSF a, AmmoInLink i a))
        (IM.toList $ itemAmmoSlots itm)

itemToFunction :: Item -> ItemStructuralFunction
itemToFunction itm = case itm ^. itType of
    DETECTOR {} -> GadgetPlatformSF
    MAPPER -> MapperSF
    ITEMSCAN -> ToggleSF
    INTROSCAN {} -> IntroScanSF
    HELD LASER -> WeaponTargetingSF
    HELD{} -> case itm ^? itUseCondition of
        Just UseableWhenAimed -> HeldPlatformSF
        --Just MustBeHeld -> UnloadedWeaponSF
        _ -> GadgetPlatformSF
    _
        | Just amtype <- magAmmoType itm-- ^? itConsumables . magType
          , Just _ <- itm ^? itLocation . ilEquipSite . _Just ->
            AmmoMagSF amtype
    AMMOMAG{} -> maybe NoSF AmmoMagSF $ magAmmoType itm -- ^? itConsumables . magType
    ATTACH REMOTESCREEN -> RemoteScreenSF
    ATTACH JOYSTICK -> JoystickSF
    ATTACH REMOTEDETONATOR -> RemoteDetonatorSF
    ATTACH SMOKEREDUCER -> SmokeReducerSF
    ATTACH BULLETSYNTH -> AmmoModifierSF BulletAmmo
    ATTACH ZOOMSCOPE -> WeaponScopeSF
    ATTACH HOMINGMODULE -> AmmoTargetingSF LauncherAmmo
    ARHUD -> ARHUDSF
    ATTACH UNDERBARRELSLOT -> UnderBarrelSlotSF
    BULLETMOD BulletModPayload{} -> AmmoPayloadSF BulletAmmo
    BULLETMOD BulletModEffect{} -> AmmoEffectSF BulletAmmo
    TARGETING{} -> WeaponTargetingSF
    EQUIP WRIST_ECG -> TriggerSF
    EQUIP{} -> EquipmentPlatformSF
    ATTACH SHELLPAYLOAD{} -> AmmoPayloadSF LauncherAmmo
    DROPPER{} -> GadgetPlatformSF
    CLICKER{} -> GadgetPlatformSF
    _ -> NoSF

structureToPotentialFunction ::
    LabelDoubleTree ItemLink ComposedItem ->
    S.Set ItemStructuralFunction
structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
    STICKYMOD -> S.singleton GrenadeHitEffectSF
    ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
    ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
    HELD GLAUNCHER -> S.singleton UnderBarrelPlatformSF
    _ -> S.singleton (ldt ^. ldtValue . _2)

baseCI :: Item -> ComposedItem
baseCI itm = (itm, itemToFunction itm, itemBaseConnections itm)

itemBaseConnections :: Item -> LinkTest
itemBaseConnections itm = case _itType itm of
    HELD LASER -> laserLinkTest itm
    CRAFT SPRING -> springLinkTest
    _ -> uncurry useBreakL $ itemToBreakLists itm (itemToFunction itm)

laserLinkTest :: Item -> LinkTest
laserLinkTest itm = LTest (llleft itm) (llright itm)

llleft :: Item -> LabelDoubleTree ItemLink ComposedItem -> Maybe LinkUpdate
llleft itm =
    _tryLeftLink
        . uncurry useBreakL
        $ itemToBreakLists itm WeaponTargetingSF

llright :: Item -> LabelDoubleTree ItemLink ComposedItem -> Maybe LinkUpdate
llright itm pci = case pci ^. ldtValue . _1 . itType of
    CRAFT TRANSFORMER -> Just (toLasgunUpdate itm)
    _ -> _tryRightLink (uncurry useBreakL $ itemToBreakLists itm WeaponTargetingSF) pci

toLasgunUpdate :: Item -> LinkUpdate
toLasgunUpdate itm =
    LUpdate
        (ILink FunctionChangeLink orientAttachment)
        (\(par, _, _) -> (par, HeldPlatformSF, uncurry useBreakL $ itemToBreakLists itm HeldPlatformSF))
        (\(chi, _, up) -> (chi, FunctionChangeSF, up))

springLinkTest :: LinkTest
springLinkTest = LTest (const Nothing) $
    \ci -> case ci ^. ldtValue . _1 . itType of
        CRAFT HARDWARE ->
            Just
                ( LUpdate
                    (ILink FunctionChangeLink orientAttachment)
                    (\(par, _, up) -> (par, MakeAutoSF, up))
                    (\(chi, _, up) -> (chi, FunctionChangeSF, up))
                )
        _ -> Nothing

--itemLinkTestLeft :: Item -> PartiallyComposedItem -> Maybe LinkUpdate
--itemLinkTestLeft itm = _tryLeftLink $
--    uncurry useBreakL $ itemToBreakLists itm

type LDTComb a b = LabelDoubleTree b a -> LabelDoubleTree b a -> Maybe (LabelDoubleTree b a)

leftIsParentCombine :: LDTComb ComposedItem ItemLink
leftIsParentCombine ltree rtree = do
    lu <- (ltree ^. ldtValue . _3 . tryRightLink) rtree --(rtree ^. ldtValue)
    return $
        ltree & ldtValue %~ (lu ^. luParentUpdate)
            & ldtRight %~ (++ [(lu ^. luLinkType, rtree & ldtValue %~ (lu ^. luChildUpdate))])

rightIsParentCombine :: LDTComb ComposedItem ItemLink
rightIsParentCombine ltree rtree = do
    lu <- (rtree ^. ldtValue . _3 . tryLeftLink) ltree -- (ltree ^. ldtValue)
    return $
        rtree & ldtValue %~ (lu ^. luParentUpdate)
            & ldtLeft .:~ (lu ^. luLinkType, ltree & ldtValue %~ (lu ^. luChildUpdate))

leftRightCombine ::
    LDTComb a b ->
    LDTComb a b ->
    LabelDoubleTree b a ->
    LabelDoubleTree b a ->
    Maybe (LabelDoubleTree b a)
leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
  where
    checkdepth t t'@(LDT x ls rs) = fromMaybe (checktop t t') $ do
        (lab, t'') <- safeHead ls
        tx <- checkdepth t t''
        return $ Just $ LDT x ((lab, tx) : tail ls) rs
    checktop t t' = f' t t'

joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
joinItemsInList f xs = snd $ h (xs, [])
  where
    h ([], zs) = ([], zs)
    h (y : ys, []) = h (ys, [y])
    h (y : ys, z : zs) = case f y z of
        Nothing -> h (ys, y : z : zs)
        Just w -> h (w : ys, zs)

-- this puts the first elements in the intmap at the end of the list
invLDT :: IM.IntMap Item -> [LabelDoubleTree ItemLink ComposedItem]
invLDT =
    joinItemsInList tryAttachItems . IM.elems
        . fmap (singleLDT . baseCI)

-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
invRootMap =
    foldMap
        (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT)
        . invLDT

-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- consider explicitly reseting the inventory ids (but this probably really
-- should be done upstream anyway in the actually creature inventory)
-- The first Int in the maybe is the root, the second the parent
invAdj :: IM.IntMap Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
invAdj = IM.unions . map g . invLDT
  where
    g = dtToLRAdj getid . ldtToDT
    getid (itm, _, _) =
        fromMaybe
            (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
            $ itm ^? itLocation . ilInvID

-- returns an intmap with trees for (only!) root items, indexed by inventory position
invRootTrees :: IM.IntMap Item -> IM.IntMap (LabelDoubleTree ItemLink ComposedItem)
invRootTrees = IM.fromDistinctAscList . reverse . map getid . invLDT
  where
    getid ::
        LabelDoubleTree ItemLink ComposedItem ->
        (Int, LabelDoubleTree ItemLink ComposedItem)
    getid t = (t ^?! ldtValue . _1 . itLocation . ilInvID, t)

-- returns an intmap with indents and locations for all items
allInvLocs :: IM.IntMap Item -> IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
allInvLocs inv = foldMap (f . LocLDT TopLDT) (IM.elems (invRootTrees inv)) mempty
  where
    f t = cldtPropagateFold h h g 0 t id
    h x _ _ _ = x + 1
    g ::
        Int ->
        LocationLDT ItemLink ComposedItem ->
        ( IM.IntMap (Int, LocationLDT ItemLink ComposedItem) ->
          IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
        ) ->
        IM.IntMap (Int, LocationLDT ItemLink ComposedItem) ->
        IM.IntMap (Int, LocationLDT ItemLink ComposedItem)
    g x ldt =
        (.)
            ( IM.insert
                (ldt ^?! locLDT . ldtValue . _1 . itLocation . ilInvID)
                (x, ldt)
            )