{-# LANGUAGE TupleSections #-}
module Dodge.Item.Grammar (
    invDT,
    invDT',
    invAdj,
    invRootMap,
    invIMDT,
    baseCI,
    invIndents,
) where

import NewInt
import Dodge.Item.Orientation
import Dodge.ItemUseCondition
import Dodge.Data.UseCondition
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 LensHelp
import ListHelp

tryAttachItems :: DTree CItem -> DTree CItem -> Maybe (DTree CItem)
tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine

itemAboveAttachables :: CItem -> [ItemSF]
itemAboveAttachables (itm,sf) = case (itm ^. itType, sf) of
    (_, HeldPlatformSF) ->
         [WeaponTargetingSF, WeaponScopeSF,TorchSF]
            <> getAutoSpringLinks itm
            <> extraWeaponLinks itm
    (DETECTOR {}, _) -> [ARHUDSF,TriggerSF,MapperSF]
    --(CRAFT TRANSFORMER, _) ->  [LaserWeaponSF]
    (LASER, _) ->  [TransformerSF]
    (MAPPER, _) -> [ARHUDSF]
    (_, GadgetPlatformSF) -> [TriggerSF, WeaponTargetingSF, WeaponScopeSF]
    _ -> []

itemBelowAttachables :: CItem -> [ItemSF]
itemBelowAttachables (itm,sf) = case (itm ^. itType, sf) of
    (LASER, WeaponTargetingSF) -> getAmmoLinks itm
    (LASER, LaserWeaponSF) -> [PulseBallSF] <> getAmmoLinks itm
    (LASER, PulseBallSF) -> [PulseBallSF]
    --(HELD LASER, _) -> [PulseBallSF]
    (HELD LED, _) -> getAmmoLinks itm
    (ATTACH CAPACITOR, _) -> [AmmoMagSF 0 ElectricalAmmo]
    (ATTACH UNDERBARRELSLOT, _) -> [UnderBarrelPlatformSF]
    (_, HeldPlatformSF) -> getAmmoLinks itm <> extraWeaponLinksBelow itm
    (_, UnderBarrelPlatformSF) -> getAmmoLinks itm
    (DETECTOR {}, _) -> getAmmoLinks itm
    (_, GadgetPlatformSF) -> getAmmoLinks itm
    (_, AmmoMagSF{}) -> fromMaybe [] $ do
        atype <- magAmmoType itm
        let screenanddet = case atype of
                LauncherAmmo ->
                    [ RemoteScreenSF
                    , RemoteDetonatorSF
                    ]
                _ -> []
        return $
             [ AmmoModifierSF atype
              , AmmoTargetingSF atype
              , AmmoPayloadSF atype
              , AmmoEffectSF atype
              , SmokeReducerSF
              ]
                <> screenanddet
            
    (_, RemoteScreenSF) -> [JoystickSF]
    (_, WeaponTargetingSF) -> getAmmoLinks itm ++ [ARHUDSF]
    (ATTACH BULLETSYNTH, _) -> [AmmoMagSF 0 ElectricalAmmo]
    _ -> []

getAutoSpringLinks :: Item -> [ItemSF]
getAutoSpringLinks itm = case baseItemTriggerType itm of
    SemiAutoTrigger _ -> [MakeAutoSF]
    _ -> []

extraWeaponLinks :: Item -> [ItemSF]
extraWeaponLinks itm = case itm ^. itType of
    HELD GLAUNCHER -> launcherlinks <> [GrenadeHitEffectSF]
    HELD RLAUNCHER -> launcherlinks
    HELD RLAUNCHERX{} -> launcherlinks
    _ -> []
  where
    launcherlinks = [ProjectileStabiliserSF]

extraWeaponLinksBelow :: Item -> [ItemSF]
extraWeaponLinksBelow itm
    | TwoHandUnder <- itemBaseStance itm = [UnderBarrelSlotSF]
    | otherwise = []

getAmmoLinks :: Item -> [ItemSF]
getAmmoLinks = map (uncurry AmmoMagSF) . IM.toList . itemAmmoSlots

itemToFunction :: Item -> ItemSF
itemToFunction itm = case itm ^. itType of
    DETECTOR {} -> GadgetPlatformSF
    MAPPER -> MapperSF
    ITEMSCAN -> ToggleSF
    INTROSCAN {} -> IntroScanSF
    LASER -> WeaponTargetingSF
    HELD LED -> TorchSF
    HELD{} -> case itUseCondition itm of
        UseableWhenAimed -> HeldPlatformSF
        _ -> GadgetPlatformSF
    _ | Just amtype <- magAmmoType itm-- ^? itConsumables . magType
          , Just _ <- itm ^? itLocation . ilEquipSite . _Just ->
            AmmoMagSF 0 amtype
    AMMOMAG{} -> maybe NoSF (AmmoMagSF 0) $ 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
    ATTACH CAPACITOR -> CapacitorSF
    CRAFT TRANSFORMER -> TransformerSF
    _ -> NoSF

treeToPotentialFunction :: DTree CItem -> S.Set ItemSF
treeToPotentialFunction ldt = case ldt ^. dtValue . _1 . itType of
    STICKYMOD -> S.singleton GrenadeHitEffectSF
    ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
    ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
    HELD GLAUNCHER -> S.singleton UnderBarrelPlatformSF
    HELD BURSTRIFLE -> S.singleton UnderBarrelPlatformSF
    LASER | sf == WeaponTargetingSF -> S.fromList [WeaponTargetingSF,LaserWeaponSF]
    -- following limits items to ten ammo slots
    _ | AmmoMagSF _ x <- ldt ^. dtValue . _2 -> S.fromList [AmmoMagSF i x | i <- [0..9]]
    ATTACH CAPACITOR -> S.fromList [CapacitorSF,PulseBallSF]
    _ -> S.singleton (ldt ^. dtValue . _2)
  where
    sf = ldt ^. dtValue . _2

baseCI :: Item -> CItem
baseCI itm = (itm, itemToFunction itm)

type DTComb a = DTree a -> DTree a -> Maybe (DTree a)

leftIsParentCombine :: DTComb CItem
leftIsParentCombine ltree rtree = do
    sf <- find (`S.member` treeToPotentialFunction rtree) (rightChildList ltree)
    let f (itm,psf) = (itm, updateLeftParentSF (itm ^. itType) psf sf)
    return $ ltree & dtRight .:~ ( rtree & dtValue . _2 .~ sf)
        & dtValue %~ f

updateLeftParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
updateLeftParentSF LASER WeaponTargetingSF TransformerSF = LaserWeaponSF
updateLeftParentSF _ psf _ = psf

rightIsParentCombine :: DTComb CItem
rightIsParentCombine ltree rtree = do
    sf <- find (`S.member` treeToPotentialFunction ltree) (leftChildList rtree)
    let f (itm,psf) = (itm, updateRightParentSF (itm ^. itType) psf sf)
    return $ rtree & dtLeft .:~ ( ltree & dtValue . _2 .~ sf)
        & dtValue %~ f

updateRightParentSF :: ItemType -> ItemSF -> ItemSF -> ItemSF
updateRightParentSF LASER LaserWeaponSF CapacitorSF = PulseLaserSF
updateRightParentSF _ psf _ = psf

leftChildList :: DTree CItem -> [ItemSF]
leftChildList t = foldl' f l (reverse $ t ^.. dtLeft . each . dtValue . _2)
  where
    l = itemBelowAttachables (t ^. dtValue)
    f x y = tail $ dropWhile (/=y) x

rightChildList :: DTree CItem -> [ItemSF]
rightChildList t = foldl' f l (reverse $ t ^.. dtRight . each . dtValue . _2)
  where
    l = itemAboveAttachables (t ^. dtValue)
    f x y = tail $ dropWhile (/=y) x

leftRightCombine :: DTComb a -> DTComb a -> DTree a -> DTree a -> Maybe (DTree a)
leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
  where
    --checkdepth t t'@(DT x ls rs) = fromMaybe (checktop t t') $ do
    checkdepth t t'@(DT x ls rs) = fromMaybe (f' t t') $ do
        t'' <- safeHead ls
        tx <- checkdepth t t''
        return $ Just $ DT x (tx : tail ls) rs
    --checktop t t' = f' t t'

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

-- this puts the first elements in the intmap at the end of the list
invDT :: NewIntMap InvInt Item -> [DTree CItem]
invDT = 
    joinItemsInList tryAttachItems . IM.elems . _unNIntMap
        . fmap (singleDT . baseCI)

invDT' :: NewIntMap InvInt Item -> [DTree OItem]
invDT' = fmap propagateOrientation . invDT

-- this assumes the creature inventory is well formed, specifically the
-- location ids
invRootMap :: NewIntMap InvInt Item -> IM.IntMap (Maybe Int, DTree Item)
invRootMap =
    foldMap
        (dtToIntMapWithRoot (^?! itLocation . ilInvID . unNInt) . fmap (^. _1) )
        . invDT

-- this assumes the creature inventory is well formed, specifically the
-- location ids
-- The first Int in the maybe is the root, the second the parent
invAdj :: NewIntMap InvInt Item -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
invAdj = IM.unions . map g . invDT
  where
    g = dtToLRAdj getid 
    getid (itm, _) =
        fromMaybe
            (error ("invAdj item " ++ show (_itID itm) ++ " location: " ++ show (itm ^? itLocation)))
            $ itm ^? itLocation . ilInvID . unNInt

---- returns an intmap with trees for (only!) root items, indexed by inventory position
invIMDT :: NewIntMap InvInt Item -> IM.IntMap (DTree OItem)
invIMDT = fmap propagateOrientation . IM.fromDistinctAscList . reverse . map getid . invDT
  where
    getid :: DTree CItem -> (Int, DTree CItem)
    getid t = (t ^?! dtValue . _1 . itLocation . ilInvID . unNInt, t)

---- returns an intmap with indents and locations for all items
invIndents :: NewIntMap InvInt Item -> IM.IntMap (Int, LocationDT OItem)
invIndents inv = foldMap (f . LocDT TopDT) (IM.elems (invIMDT inv)) mempty
  where
    f t = cdtPropagateFold h h g 0 t id
    h x _ _ = x + 1
    g ::
        Int ->
        LocationDT OItem ->
        ( IM.IntMap (Int, LocationDT OItem) ->
          IM.IntMap (Int, LocationDT OItem)
        ) ->
        IM.IntMap (Int, LocationDT OItem) ->
        IM.IntMap (Int, LocationDT OItem)
    g x ldt =
        (.)
            ( IM.insert
                (ldt ^?! locDT . dtValue . _1 . itLocation . ilInvID . unNInt)
                (x, ldt)
            )