From dc631263da5cb7f4a2c6d2bfbcdc94cb98f66dad Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 12 Jul 2025 21:35:35 +0100 Subject: [PATCH] Cleanup, hlints --- src/Dodge/Creature/Impulse/UseItem.hs | 8 ++--- src/Dodge/Creature/State.hs | 11 ++++--- src/Dodge/Creature/Test.hs | 2 +- src/Dodge/Data/DoubleTree.hs | 16 +++++----- src/Dodge/DoubleTree.hs | 19 ++++++------ src/Dodge/HeldUse.hs | 42 +++++++++++++-------------- src/Dodge/Item/Draw.hs | 2 +- src/Dodge/Item/Grammar.hs | 30 +++++-------------- src/Dodge/WorldEffect.hs | 2 +- 9 files changed, 58 insertions(+), 74 deletions(-) diff --git a/src/Dodge/Creature/Impulse/UseItem.hs b/src/Dodge/Creature/Impulse/UseItem.hs index 5e2acfd0c..03f41ef9f 100644 --- a/src/Dodge/Creature/Impulse/UseItem.hs +++ b/src/Dodge/Creature/Impulse/UseItem.hs @@ -19,7 +19,7 @@ useItem :: Int -> PressType -> World -> Maybe World useItem invid pt w = fmap (worldEventFlags . at InventoryChange ?~ ()) $ do cr <- w ^? cWorld . lWorld . creatures . ix 0 itmloc <- invIndents (_crInv cr) ^? ix invid . _2 - useItemLoc cr (itmloc) pt w + useItemLoc cr itmloc pt w useItemLoc :: Creature -> LocationDT OItem -> PressType -> World -> Maybe World useItemLoc cr loc pt w @@ -30,13 +30,13 @@ useItemLoc cr loc pt w | LaserWeaponSF <- sf , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached , Aiming{} <- cr ^. crStance . posture = - return $ gadgetEffect pt (loc) cr w + return $ gadgetEffect pt loc cr w | GadgetPlatformSF <- sf = - return $ gadgetEffect pt (loc) cr w + return $ gadgetEffect pt loc cr w | UnderBarrelPlatformSF <- sf , fromMaybe False $ loc ^? locDT . dtValue . _1 . itLocation . ilIsAttached , Aiming{} <- cr ^. crStance . posture = - return $ gadgetEffect pt (loc) cr w + return $ gadgetEffect pt loc cr w | RemoteDetonatorSF <- sf , pt == InitialPress = return $ activateDetonator ldt w diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index dff1d143d..b0864dd3f 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -153,7 +153,7 @@ invRootItemEffs cr = invItemLocUpdate :: Creature -> LocationDT OItem -> World -> World invItemLocUpdate cr loc w = doAnyEquipmentEffect loc cr $ case itm ^. itType of ATTACH BULLETSYNTH -> trySynthBullet loc w - EQUIP WRIST_ECG | haspulse -> tryUseParent (loc) w + EQUIP WRIST_ECG | haspulse -> tryUseParent loc w COPIER _ -> copierItemUpdate itm cr w HELD FLATSHIELD -> rootNotrootEff createShieldWall removeShieldWall itm cr w HELD MINIGUNX{} -> coolMinigun itm w @@ -293,8 +293,7 @@ drawARHUD (LocDT con _) w = fromMaybe w $ do shineTargetLaser :: Creature -> LocationDT OItem -> World -> World shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ do guard (crIsAiming cr) --- (_, mag) <- find (isammolink . fst) (itmtree ^. ldtLeft) - ( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft) + mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft) i <- mag ^. dtValue . _1 . itConsumables guard $ i >= x maginvid <- mag ^? dtValue . _1 . itLocation . ilInvID @@ -316,7 +315,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d , _lpType = TargetingLaser (_itID itm) } where - o = locOrient (loc) cr + o = locOrient loc cr itmtree = loc ^. locDT (p, q) = o `Q.comp` (V3 5 0 0, Q.qID) x = 1 @@ -332,7 +331,7 @@ shineTargetLaser cr loc w = fromMaybe (w & pointittarg . itTgPos .~ Nothing) $ d shineTorch :: Creature -> LocationDT OItem -> World -> World shineTorch cr loc = fromMaybe id $ do - ( mag) <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft) + mag <- find (isammolink . (^. dtValue . _2)) (itmtree ^. dtLeft) i <- mag ^. dtValue . _1 . itConsumables guard $ crIsAiming cr guard $ i >= x @@ -342,7 +341,7 @@ shineTorch cr loc = fromMaybe id $ do . (cWorld . lWorld . creatures . ix (_crID cr) . crInv . ix invid . itConsumables . _Just -~ x) where itmtree = loc ^. locDT - (p, q) = locOrient (loc) cr + (p, q) = locOrient loc cr x = 10 isammolink AmmoMagSF{} = True isammolink _ = False diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 6feee591d..d8b5ffcc3 100644 --- a/src/Dodge/Creature/Test.hs +++ b/src/Dodge/Creature/Test.hs @@ -97,7 +97,7 @@ crInAimStance as cr = crIsAiming cr && mitstance == Just as i <- cr ^? crManipulation . manObject . imRootSelectedItem --itm <- invRootTrees' (cr ^. crInv) ^? ix i itm <- fmap (fmap (\(a,b,_) -> (a,b))) $ invIMDT (cr ^. crInv) ^? ix i - return $ aimStance $ itm + return $ aimStance itm --cr ^? crInv . ix i . itUse . heldAim . aimStance oneH :: Creature -> Bool diff --git a/src/Dodge/Data/DoubleTree.hs b/src/Dodge/Data/DoubleTree.hs index ee01a0aec..7063c9110 100644 --- a/src/Dodge/Data/DoubleTree.hs +++ b/src/Dodge/Data/DoubleTree.hs @@ -113,7 +113,7 @@ makeLenses ''ContextDT instance Functor (LocationLDT b) where fmap f (LocLDT c t) = LocLDT (fmap f c) (fmap f t) -instance Functor (LocationDT) where +instance Functor LocationDT where fmap f (LocDT c t) = LocDT (fmap f c) (fmap f t) instance Functor (ContextLDT b) where @@ -133,20 +133,20 @@ instance Functor (ContextLDT b) where l (fmap (fmap (fmap f)) cr) -instance Functor (ContextDT) where +instance Functor ContextDT where fmap f = \case TopDT -> TopDT LeftwardDT u cl p cr fr -> LeftwardDT (fmap f u) - (fmap (fmap ( f)) cl) + (fmap (fmap f) cl) (f p) - (fmap (fmap ( f)) cr) - (fmap (fmap ( f)) fr) + (fmap (fmap f) cr) + (fmap (fmap f) fr) RightwardDT u fl cl p cr -> RightwardDT (fmap f u) - (fmap (fmap ( f)) fl) - (fmap (fmap ( f)) cl) + (fmap (fmap f) fl) + (fmap (fmap f) cl) (f p) - (fmap (fmap ( f)) cr) + (fmap (fmap f) cr) --deriveJSON defaultOptions ''DoubleTree --deriveJSON defaultOptions ''LabelDoubleTree diff --git a/src/Dodge/DoubleTree.hs b/src/Dodge/DoubleTree.hs index a6a7773a2..33627c69c 100644 --- a/src/Dodge/DoubleTree.hs +++ b/src/Dodge/DoubleTree.hs @@ -37,16 +37,15 @@ conLDTToConDT = \case dtStartPropagate :: (a -> c) -> (c -> a -> c) -> DTree a -> DTree c dtStartPropagate g f (DT x l r) = DT z - (fmap (\(t) -> (dtPropagate' z f t)) l) - (fmap (\(t) -> (dtPropagate' z f t)) r) + (fmap (dtPropagate' f z) l) + (fmap (dtPropagate' f z) r) where z = g x - -dtPropagate' :: c -> (c -> a -> c) -> DTree a -> DTree c -dtPropagate' x f (DT y l r) = DT z - (fmap (\(t) -> (dtPropagate' z f t)) l) - (fmap (\(t) -> (dtPropagate' z f t)) r) +dtPropagate' :: (c -> a -> c) -> c -> DTree a -> DTree c +dtPropagate' f x (DT y l r) = DT z + (fmap (dtPropagate' f z) l) + (fmap (dtPropagate' f z) r) where z = f x y @@ -291,12 +290,12 @@ locUp' (LocDT c@LeftwardDT{} t) = Just $ LocDT (_cdtUp c) - (DT (_cdtParent c) (_cdtCloseLeft c ++ (( t) : _cdtCloseRight c)) (_cdtFarRight c)) + (DT (_cdtParent c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c)) (_cdtFarRight c)) locUp' (LocDT c@RightwardDT{} t) = Just $ LocDT (_cdtUp c) - (DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ (( t) : _cdtCloseRight c))) + (DT (_cdtParent c) (_cdtFarLeft c) (_cdtCloseLeft c ++ ( t : _cdtCloseRight c))) locToTop' :: LocationDT a -> LocationDT a locToTop' loc = maybe loc locToTop' $ locUp' loc @@ -333,7 +332,7 @@ locDTGoLeft (LocDT c (DT v l r)) = -- should probably do tests for these locDTGoRight :: LocationDT a -> [LocationDT a] locDTGoRight (LocDT c (DT v l r)) = - [LocDT (RightwardDT c l closel v closer) t | (closel, ( t), closer) <- locDTGoHelp id r] + [LocDT (RightwardDT c l closel v closer) t | (closel, t, closer) <- locDTGoHelp id r] -- this seems like it might be very inefficient for large lists -- difference lists? diff --git a/src/Dodge/HeldUse.hs b/src/Dodge/HeldUse.hs index ca450b945..ff0221620 100644 --- a/src/Dodge/HeldUse.hs +++ b/src/Dodge/HeldUse.hs @@ -69,19 +69,19 @@ hammerCheck :: World hammerCheck f pt loc cr w = case itemTriggerType loc of WarmUpNoDelay wm - | _wTime (_itParams $ it) < wm -> + | _wTime (_itParams it) < wm -> w & setwarming & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2) & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpNoDelay{} -> f loc cr w & setwarming WarmUpCoolDown ws _ _ -- UNSAFE: - | _wTime (_itParams $ it) < ws -> + | _wTime (_itParams it) < ws -> w & setwarming & soundContinue (CrWeaponSound cid 0) (_crPos cr) (warmupSound $ it ^. itType) (Just 2) & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpCoolDown _ cs _ - | _wTime (_itParams $ it) < cs -> + | _wTime (_itParams it) < cs -> f loc cr w & setwarming & cWorld . lWorld . creatures . ix cid . crInv . ix invid . itParams . wTime +~ 1 WarmUpCoolDown{} -> w & setwarming @@ -671,7 +671,7 @@ loadMuzzle :: loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do let as = _mzAmmoSlot mz amamount = _mzAmmoPerShot mz - (i, ( mag)) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l + (i, mag) <- findWithIx (isAmmoIntLink as . (^. dtValue . _2)) l availableammo <- mag ^. dtValue . _1 . itConsumables let usedammo = case amamount of UseUpTo x -> min x availableammo @@ -681,7 +681,7 @@ loadMuzzle t@(DT _ l _) mz = fromMaybe (t, Nothing) $ do guard $ usedammo > 0 return ( t & dtLeft . ix i . dtValue . _1 . itConsumables . _Just -~ usedammo - , Just (mz, usedammo, (mag)) + , Just (mz, usedammo, mag) ) makeMuzzleFlare :: Muzzle -> LocationDT OItem -> Creature -> World -> World @@ -771,9 +771,9 @@ useLoadedAmmo loc cr (_, w) (Just (mz, x, magtree)) = (,) True $ MuzzleGLauncher -> createProjectile (itmtree ^. dtValue . _3) - (Grenade (getGrenadeHitEffect $ itmtree)) + (Grenade (getGrenadeHitEffect itmtree)) magtree - (getPJStabiliser $ itmtree) + (getPJStabiliser itmtree) mz cr w @@ -933,14 +933,14 @@ getBulletType magtree = bpayload = fromMaybe (BulPlain 100) $ do attree <- find ispayload (magtree ^. dtLeft) attree ^? dtValue . _1 . itUse . ubMod . bmPayload - ispayload :: (DTree OItem) -> Bool + ispayload :: DTree OItem -> Bool ispayload y = case y ^. dtValue . _2 of AmmoPayloadSF {} -> True _ -> False beffect = fromMaybe DestroyBullet $ do attree <- find isammoeffect (magtree ^. dtLeft) attree ^? dtValue . _1 . itUse . ubMod . bmEffect - isammoeffect :: (DTree OItem) -> Bool + isammoeffect :: DTree OItem -> Bool isammoeffect y = case y ^. dtValue . _2 of AmmoEffectSF {} -> True _ -> False @@ -984,7 +984,7 @@ shootBullets :: World -> World shootBullets loc cr (mz, x, magtree) w = fromMaybe w $ do - thebullet <- getBulletType $ magtree + thebullet <- getBulletType magtree return $ foldl' (&) w (replicate x (shootBullet thebullet loc cr mz)) shootBullet :: Bullet -> LocationDT OItem -> Creature -> Muzzle -> World -> World @@ -1246,19 +1246,19 @@ determineProjectileTracking magtree itmtree = _ <- find isammotargeting (magtree ^. dtLeft) targetingtree <- find isweapontargeting (itmtree ^. dtRight) return $ HomeUsingTargeting (targetingtree ^. dtValue . _1 . itID) - isremscreen :: (DTree OItem) -> Bool + isremscreen :: DTree OItem -> Bool isremscreen x = case x ^. dtValue . _2 of RemoteScreenSF {} -> True _ -> False - isjoystick :: (DTree OItem) -> Bool + isjoystick :: DTree OItem -> Bool isjoystick x = case x ^. dtValue . _2 of JoystickSF {} -> True _ -> False - isammotargeting :: (DTree OItem) -> Bool + isammotargeting :: DTree OItem -> Bool isammotargeting x = case x ^. dtValue . _2 of AmmoTargetingSF {} -> True _ -> False - isweapontargeting :: (DTree OItem) -> Bool + isweapontargeting :: DTree OItem -> Bool isweapontargeting x = case x ^. dtValue . _2 of WeaponTargetingSF {} -> True _ -> False @@ -1274,7 +1274,7 @@ createProjectileR loc magtree = createProjectile (loc ^. locDT . dtValue . _3) ( Rocket - (determineProjectileTracking ( magtree) $ itmtree) + (determineProjectileTracking magtree itmtree) smoke ) magtree @@ -1284,7 +1284,7 @@ createProjectileR loc magtree = smoke | isJust $ find issmokereducer (magtree ^. dtLeft) = Just ReducedRocketSmoke | otherwise = Nothing - issmokereducer :: (DTree OItem) -> Bool + issmokereducer :: DTree OItem -> Bool issmokereducer y = case y ^. dtValue . _2 of SmokeReducerSF {} -> True _ -> False @@ -1297,7 +1297,7 @@ getPJStabiliser ldt = case find isprojstab (ldt ^. dtRight) of _ -> Nothing _ -> Nothing where - isprojstab :: (DTree OItem) -> Bool + isprojstab :: DTree OItem -> Bool isprojstab y = case y ^.dtValue . _2 of ProjectileStabiliserSF {} -> True _ -> False @@ -1309,7 +1309,7 @@ getGrenadeHitEffect t = case find isghiteff (t ^. dtRight) of _ -> GBounce 2 _ -> GBounce 2 where - isghiteff :: (DTree OItem) -> Bool + isghiteff :: DTree OItem -> Bool isghiteff y = case y ^. dtValue . _2 of GrenadeHitEffectSF {} -> True _ -> False @@ -1340,15 +1340,15 @@ createProjectile x pjtype magtree stab muz cr = fromMaybe failsound $ do createShell x rdetonate rscreen stab pjtype aparams muz cr . startthesound where - isrdet :: (DTree OItem) -> Bool + isrdet :: DTree OItem -> Bool isrdet y = case y ^. dtValue . _2 of RemoteDetonatorSF {} -> True _ -> False - isrscreen :: (DTree OItem) -> Bool + isrscreen :: DTree OItem -> Bool isrscreen y = case y ^. dtValue . _2 of RemoteScreenSF {} -> True _ -> False - isampay :: (DTree OItem) -> Bool + isampay :: DTree OItem -> Bool isampay y = case y ^. dtValue . _2 of AmmoPayloadSF {} -> True _ -> False diff --git a/src/Dodge/Item/Draw.hs b/src/Dodge/Item/Draw.hs index 9fd85b553..a61097d63 100644 --- a/src/Dodge/Item/Draw.hs +++ b/src/Dodge/Item/Draw.hs @@ -23,7 +23,7 @@ itemEquipPict cr itmtree , Just attachpos <- equipAttachPos <$> itm ^? itType . ibtEquip = equipPosition esite cr attachpos (itemSPic itm) | itm ^? itLocation . ilInvID == cr ^? crManipulation . manObject . imRootSelectedItem - = overPosSP (Q.prePos $ handHandleOrient (loc) cr) (itemTreeSPic $ itmtree) + = overPosSP (Q.prePos $ handHandleOrient loc cr) (itemTreeSPic itmtree) | otherwise = mempty where itm = itmtree ^. dtValue . _1 diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 0161d261d..e2ef43f91 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -1,15 +1,12 @@ {-# LANGUAGE TupleSections #-} module Dodge.Item.Grammar ( invDT, --- invLDT, invDT', invAdj, invRootMap, --- invRootTrees, invIMDT, baseCI, invIndents, --- allInvLocs, ) where import Dodge.Item.Orientation @@ -52,15 +49,6 @@ tryAttachItems = leftRightCombine leftIsParentCombine rightIsParentCombine -- [(JoystickSF, JoystickLink)] -- _ -> [] ---itemToBreakLists :: --- Item -> --- ItemStructuralFunction -> --- ([(ItemStructuralFunction, ItemLink)], [(ItemStructuralFunction, ItemLink)]) ---itemToBreakLists itm itmf = (fmap f l, fmap f r) --- where --- f x = (x, SFLink x) --- (l,r) = itemToBreakLists' itm itmf - itemToBreakLists :: Item -> ItemStructuralFunction -> @@ -71,7 +59,7 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of (_, HeldPlatformSF) -> ( getAmmoLinks itm <> extraWeaponLinksBelow itm - , [(WeaponTargetingSF), (WeaponScopeSF)] + , [WeaponTargetingSF, WeaponScopeSF] <> getAutoSpringLinks itm <> extraWeaponLinks itm ) @@ -79,23 +67,23 @@ itemToBreakLists itm itmf = case (itm ^. itType, itmf) of ( getAmmoLinks itm,[]) (DETECTOR {}, _) -> ( getAmmoLinks itm - , [(ARHUDSF),(TriggerSF),(MapperSF)] + , [ARHUDSF,TriggerSF,MapperSF] ) - (CRAFT TRANSFORMER, _) -> ([],[(LaserWeaponSF)]) + (CRAFT TRANSFORMER, _) -> ([],[LaserWeaponSF]) (MAPPER, _) -> ( [] - , [(ARHUDSF)] + , [ARHUDSF] ) (_, GadgetPlatformSF) -> ( getAmmoLinks itm - , [(TriggerSF), (WeaponTargetingSF), (WeaponScopeSF)] + , [TriggerSF, WeaponTargetingSF, WeaponScopeSF] ) (_, AmmoMagSF{}) -> fromMaybe ([], []) $ do atype <- magAmmoType itm let screenanddet = case atype of LauncherAmmo -> - [ (RemoteScreenSF) - , (RemoteDetonatorSF) + [ RemoteScreenSF + , RemoteDetonatorSF ] _ -> [] return @@ -133,9 +121,7 @@ extraWeaponLinks itm = case itm ^. itType of extraWeaponLinksBelow :: Item -> [(ItemStructuralFunction)] extraWeaponLinksBelow itm --- | Just TwoHandUnder <- itm ^? itUse . heldAim . aimStance - | TwoHandUnder <- itemBaseStance itm - = [(UnderBarrelSlotSF)] + | TwoHandUnder <- itemBaseStance itm = [(UnderBarrelSlotSF)] | otherwise = [] getAmmoLinks :: Item -> [(ItemStructuralFunction)] diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index f847408d1..330f229c6 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -47,7 +47,7 @@ doWdWd we = case we of cr <- w ^? cWorld . lWorld . creatures . ix cid --itree <- allInvLocs (cr ^. crInv) ^? ix invid . _2 . locLDT loc <- invIndents (cr ^. crInv) ^? ix invid . _2 - return $ heldEffectMuzzles (loc) cr w + return $ heldEffectMuzzles loc cr w accessTerminal :: Maybe Int -> World -> World accessTerminal mtmid w = fromMaybe w $ do