Child items set to be above xor below

ghcidOutput

@@ -1 +1 @@
-All good (614 modules, at 16:33:21)
+All good (614 modules, at 16:50:05)

src/Dodge/Item/Grammar.hs

@@ -5,68 +5,68 @@ import ListHelp
 import Dodge.Data.Item
 import Dodge.Data.DoubleTree
 import Dodge.Data.ComposedItem
-import TreeHelp
+--import TreeHelp
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 
-type PCI = (ComposedItem, [ComposedItem])
+type PCI = (ComposedItem, [ComposedItem], [ComposedItem])
 
-type PCI' = (Item,ComposedItem, [ComposedItem])
+type PCI' = (Item,ComposedItem,[ComposedItem], [ComposedItem])
 
 singleDT :: a -> DoubleTree a
 singleDT x = DT x [] []
 
 baseComposedItem :: ItemBaseType -> PCI
 baseComposedItem ibt = case ibt of
-    HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI])
+    HELD BURSTRIFLE -> (WeaponCI, [BulletAmmoCI], [])
-    AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI])
+    AMMOMAG TINMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
-    AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI])
+    AMMOMAG DRUMMAG -> (BulletAmmoCI, [AmmoModifierCI], [])
-    ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [])
+    ATTACH BULLETSYNTHESIZER -> (AmmoModifierCI, [], [])
-    _ -> (UncomposableCI, [])
+    _ -> (UncomposableCI, [], [])
 
 baseCI :: Item -> PCI'
-baseCI itm = let (a,b) = baseComposedItem (itm ^. itType . iyBase)
+baseCI itm = let (a,b,c) = baseComposedItem (itm ^. itType . iyBase)
-  in (itm, a, b)
+  in (itm, a, b, c)
 
 joinItems :: DoubleTree PCI' -> DoubleTree PCI' -> Maybe (DoubleTree PCI')
-joinItems t@(DT (itm,px,cx) ls' rs') s@(DT (_,py,_) _ _)
+joinItems t@(DT (itm,px,lc',rc') ls' rs') s@(DT (_,py,_,_) _ _)
-    | py `elem` cx = Just (DT (itm,px, delete py cx) ls' (rs' ++ [s]))
+    | py `elem` rc' = Just (DT (itm,px,lc', delete py rc') ls' (rs' ++ [s]))
     | otherwise = checkdepth t s
   where
     checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
         c <- safeHead ls
         d <- checkdepth a c
         return $ Just $ DT b (d:tail ls) rs
-    checktop a@(DT (_,pa,_) _ _) (DT (itm2,pb,cb) ls rs)
+    checktop a@(DT (_,pa,_,_) _ _) (DT (itm2,pb,lc,rc) ls rs)
-        | pa `elem` cb = Just (DT (itm2,pb, delete pa cb) (a:ls) rs)
+        | pa `elem` lc = Just (DT (itm2,pb, delete pa lc,rc) (a:ls) rs)
         | otherwise = Nothing
 
-joinItems' :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI)
+--joinItems' :: DoubleTree PCI -> DoubleTree PCI -> Maybe (DoubleTree PCI)
-joinItems' t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _)
+--joinItems' t@(DT (px,cx) ls' rs') s@(DT (py,_) _ _)
-    | py `elem` cx = Just (DT (px, delete py cx) ls' (rs' ++ [s]))
+--    | py `elem` cx = Just (DT (px, delete py cx) ls' (rs' ++ [s]))
-    | otherwise = checkdepth t s
+--    | otherwise = checkdepth t s
-  where
+--  where
-    checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
+--    checkdepth a a'@(DT b ls rs) = fromMaybe (checktop a a') $ do
-        c <- safeHead ls
+--        c <- safeHead ls
-        d <- checkdepth a c
+--        d <- checkdepth a c
-        return $ Just $ DT b (d:ls) rs
+--        return $ Just $ DT b (d:ls) rs
-    checktop a@(DT (pa,_) _ _) (DT (pb,cb) ls rs)
+--    checktop a@(DT (pa,_) _ _) (DT (pb,cb) ls rs)
-        | pa `elem` cb = Just (DT (pb, delete pa cb) (a:ls) rs)
+--        | pa `elem` cb = Just (DT (pb, delete pa cb) (a:ls) rs)
-        | otherwise = Nothing
+--        | otherwise = Nothing
-
+--
-joinItems'' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI)
+--joinItems'' :: Tree PCI -> Tree PCI -> Maybe (Tree PCI)
-joinItems'' t@(Node (px,cx) xs) s@(Node (py,_) _)
+--joinItems'' t@(Node (px,cx) xs) s@(Node (py,_) _)
---    | fst y `elem` cx = Just (Node (px, delete y cx) (xs ++ [s]))
+----    | fst y `elem` cx = Just (Node (px, delete y cx) (xs ++ [s]))
-    | py `elem` cx = Just (Node (px, delete py cx) (xs ++ [s]))
+--    | py `elem` cx = Just (Node (px, delete py cx) (xs ++ [s]))
-    | otherwise = checkdepth t s
+--    | otherwise = checkdepth t s
-  where
+--  where
-    checkdepth a a'@(Node b cs) = fromMaybe (checktop a a') $ do
+--    checkdepth a a'@(Node b cs) = fromMaybe (checktop a a') $ do
-        c <- safeHead cs
+--        c <- safeHead cs
-        d <- checkdepth a c
+--        d <- checkdepth a c
-        return $ Just $ Node b (d:cs)
+--        return $ Just $ Node b (d:cs)
-    checktop a@(Node (pa,_) _) (Node (pb,cb) bs)
+--    checktop a@(Node (pa,_) _) (Node (pb,cb) bs)
-        | pa `elem` cb = Just (Node (pb, delete pa cb) (a:bs))
+--        | pa `elem` cb = Just (Node (pb, delete pa cb) (a:bs))
-        | otherwise = Nothing
+--        | otherwise = Nothing
 
 joinItemsInList :: (a -> a -> Maybe a) -> [a] -> [a]
 joinItemsInList f xs = snd $ h (xs,[])
@@ -114,7 +114,7 @@ prettyDT f (DT x l r) = concatMap (map ('/':) . prettyDT f) r
     ++ (f x : concatMap (map ('\\':) . prettyDT f) l)
 
 invTree :: IM.IntMap Item -> [String]
-invTree = concatMap (prettyDT (\(itm,_,_) -> show (_itType itm))) .
+invTree = concatMap (prettyDT (\(itm,_,_,_) -> show (_itType itm))) .
       joinItemsInList joinItems . IM.elems .    fmap (singleDT . baseCI)
 
 indentInv :: IM.IntMap Item -> IM.IntMap String