justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Eta reduction

Browse Source
This commit is contained in:
justin
2025-07-10 00:13:57 +01:00
parent 15db129633
commit f557d5b954
1 changed files with 20 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Grammar.hs
+20 -14
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Item.Grammar ( module Dodge.Item.Grammar (
invLDT, invLDT,
invLDT', invLDT',
@@ -152,8 +153,8 @@ itemToFunction itm = case itm ^. itType of
CLICKER{} -> GadgetPlatformSF CLICKER{} -> GadgetPlatformSF
_ -> NoSF _ -> NoSF
structureToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction treeToPotentialFunction :: LDTree ItemLink CItem -> S.Set ItemStructuralFunction
structureToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of treeToPotentialFunction ldt = case ldt ^. ldtValue . _1 . itType of
STICKYMOD -> S.singleton GrenadeHitEffectSF STICKYMOD -> S.singleton GrenadeHitEffectSF
ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF ATTACH GIMBAL -> S.singleton ProjectileStabiliserSF
ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF ATTACH GYROSCOPE -> S.singleton ProjectileStabiliserSF
@@ -169,18 +170,16 @@ type LDTComb a b = LDTree b a -> LDTree b a -> Maybe (LDTree b a)
leftIsParentCombine :: LDTComb CItem ItemLink leftIsParentCombine :: LDTComb CItem ItemLink
leftIsParentCombine ltree rtree = do leftIsParentCombine ltree rtree = do
let l = rightChildList ltree let l = rightChildList ltree
xs = dropWhile ((\s -> not $ S.member s (structureToPotentialFunction rtree)) . fst) l xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction rtree)) . fst) l
(sf,linktype) <- safeHead xs (sf,linktype) <- safeHead xs
return $ return $ ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
ltree & ldtRight .:~ (linktype, rtree & ldtValue . _2 .~ sf)
rightIsParentCombine :: LDTComb CItem ItemLink rightIsParentCombine :: LDTComb CItem ItemLink
rightIsParentCombine ltree rtree = do rightIsParentCombine ltree rtree = do
let l = leftChildList rtree let l = leftChildList rtree
xs = dropWhile ((\s -> not $ S.member s (structureToPotentialFunction ltree)) . fst) l xs = dropWhile ((\s -> not $ S.member s (treeToPotentialFunction ltree)) . fst) l
(sf,linktype) <- safeHead xs (sf,linktype) <- safeHead xs
return $ return $ rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
rtree & ldtLeft .:~ (linktype, ltree & ldtValue . _2 .~ sf)
leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)] leftChildList :: LDTree ItemLink CItem -> [(ItemStructuralFunction, ItemLink)]
leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1) leftChildList t = foldl' f l (reverse $ t ^.. ldtLeft . each . _1)
@@ -209,13 +208,20 @@ leftRightCombine f f' t1 t2 = f t1 t2 <|> checkdepth t1 t2
checktop t t' = f' t t' checktop t t' = f' t t'
joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a] joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
joinItemsInList f xs = snd $ h (xs, []) joinItemsInList f = fst . h . ([],)
where where
h ([], zs) = ([], zs) h (zs, []) = (zs, [])
h (y : ys, []) = h (ys, [y]) h ([],y : ys) = h ([y],ys)
h (y : ys, z : zs) = case f y z of h ( z : zs, y : ys) = case f y z of
Nothing -> h (ys, y : z : zs) Nothing -> h ( y : z : zs,ys)
Just w -> h (w : ys, zs) Just w -> h ( zs,w : ys)
--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 -- this puts the first elements in the intmap at the end of the list
invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem] invLDT :: IM.IntMap Item -> [LDTree ItemLink CItem]