diff --git a/src/Dodge/Data/DoubleTree.hs b/src/Dodge/Data/DoubleTree.hs index 7df898e10..e2db9f3a8 100644 --- a/src/Dodge/Data/DoubleTree.hs +++ b/src/Dodge/Data/DoubleTree.hs @@ -28,7 +28,7 @@ data LabelDoubleTreeNodeType a | LDTMidBelowNode a | LDTBottomNode a -data DoubleTree a = DT {_dtValue :: a, _dtLeft :: [DoubleTree a], _dtRight :: [DoubleTree a]} +data DTree a = DT {_dtValue :: a, _dtLeft :: [DTree a], _dtRight :: [DTree a]} deriving (Eq, Ord, Show, Read) data LDTree b a = LDT -- LabelDoubleTree @@ -63,10 +63,10 @@ data LocationLDT b a = LocLDT , _locLDT :: LDTree b a } -instance Functor DoubleTree where +instance Functor DTree where fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r) -instance Foldable DoubleTree where +instance Foldable DTree where foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r instance Functor (LDTree b) where @@ -85,25 +85,25 @@ data ContextDT a = TopDT | LeftwardDT { _cdtUp :: ContextDT a - , _cdtCloseLeft :: [DoubleTree a] + , _cdtCloseLeft :: [DTree a] , _cdtParent :: a - , _cdtCloseRight :: [DoubleTree a] - , _cdtFarRight :: [DoubleTree a] + , _cdtCloseRight :: [DTree a] + , _cdtFarRight :: [DTree a] } | RightwardDT { _cdtUp :: ContextDT a - , _cdtFarLeft :: [ DoubleTree a] - , _cdtCloseLeft :: [DoubleTree a] + , _cdtFarLeft :: [ DTree a] + , _cdtCloseLeft :: [DTree a] , _cdtParent :: a - , _cdtCloseRight :: [DoubleTree a] + , _cdtCloseRight :: [DTree a] } data LocationDT b a = LocDT { _locDtContext :: ContextDT a - , _locDT :: DoubleTree a + , _locDT :: DTree a } -makeLenses ''DoubleTree +makeLenses ''DTree makeLenses ''LDTree makeLenses ''LocationLDT makeLenses ''ContextLDT diff --git a/src/Dodge/DoubleTree.hs b/src/Dodge/DoubleTree.hs index 8ae7d0036..72c06d94f 100644 --- a/src/Dodge/DoubleTree.hs +++ b/src/Dodge/DoubleTree.hs @@ -6,13 +6,13 @@ import qualified Data.IntMap.Strict as IM import Data.Monoid import Dodge.Data.DoubleTree -singleDT :: a -> DoubleTree a +singleDT :: a -> DTree a singleDT x = DT x [] [] singleLDT :: a -> LDTree b a singleLDT x = LDT x [] [] -ldtToDT :: LDTree b a -> DoubleTree a +ldtToDT :: LDTree b a -> DTree a ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r) ldtStartPropagate :: (a -> c) -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c @@ -92,10 +92,10 @@ ldtPropagateIndices (LDT x l r) = LDT (x, []) (imap (f Left) l) (imap (f Right) -- conceptually, in a tree growing from left to right, -- bottom -> top is equated with left -> right. -- this does not match with thinking of a list as top -> bottom, so take care -doubleTreeToIndentList :: DoubleTree a -> [(a, Int, DoubleTreeNodeType)] +doubleTreeToIndentList :: DTree a -> [(a, Int, DoubleTreeNodeType)] doubleTreeToIndentList = dtIL DTRootNode -dtIL :: DoubleTreeNodeType -> DoubleTree a -> [(a, Int, DoubleTreeNodeType)] +dtIL :: DoubleTreeNodeType -> DTree a -> [(a, Int, DoubleTreeNodeType)] dtIL nt (DT x l r) = map doindent (concat (headMap (dtIL DTBottomNode) (dtIL DTMidBelowNode) l)) ++ [(x, 0, nt)] @@ -103,7 +103,7 @@ dtIL nt (DT x l r) = where doindent (a, b, c) = (a, b + 1, c) -dtToAdjacency :: (a -> Int) -> DoubleTree a -> IM.IntMap [Int] +dtToAdjacency :: (a -> Int) -> DTree a -> IM.IntMap [Int] dtToAdjacency f (DT x l r) = IM.insert (f x) (map g l <> map g r) . IM.unions @@ -111,17 +111,17 @@ dtToAdjacency f (DT x l r) = where g = f . _dtValue -dtToIntMapWithRoot :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a) +dtToIntMapWithRoot :: (a -> Int) -> DTree a -> IM.IntMap (Maybe Int, DTree a) dtToIntMapWithRoot f t@(DT x l r) = IM.insert (f x) (Nothing, t) $ foldMap (dtToRootIntMap' (f x) f) $ l <> r -dtToRootIntMap' :: Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a) +dtToRootIntMap' :: Int -> (a -> Int) -> DTree a -> IM.IntMap (Maybe Int, DTree a) dtToRootIntMap' root f t@(DT x l r) = IM.insert (f x) (Just root, t) $ foldMap (dtToRootIntMap' root f) $ l <> r -dtToUpDownAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap ([Int], [Int]) +dtToUpDownAdj :: (a -> Int) -> DTree a -> IM.IntMap ([Int], [Int]) dtToUpDownAdj f (DT x l r) = IM.insert (f x) (map g l, map g r) . IM.unions @@ -131,7 +131,7 @@ dtToUpDownAdj f (DT x l r) = -- returns an adjacency map with oldest ancestor and direct parent if they exist -- and any left and right children -dtToLRAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) +dtToLRAdj :: (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) dtToLRAdj f (DT x l r) = IM.insert i (Nothing, map g l, map g r) . IM.unions @@ -145,7 +145,7 @@ dtToLRAdj f (DT x l r) = -- allows to propagate failure in the index discovery dtToLRAdjEither :: (a -> Either String Int) -> - DoubleTree a -> + DTree a -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int])) dtToLRAdjEither f (DT x l r) = do i <- f x @@ -158,7 +158,7 @@ dtToLRAdjEither f (DT x l r) = do where g = f . _dtValue -dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) +dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int]) dtToAdjRootParent root par f (DT x l r) = IM.insert (f x) (Just (root, par), map g l, map g r) . IM.unions @@ -170,7 +170,7 @@ dtToAdjRootParentEither :: Int -> Int -> (a -> Either String Int) -> - DoubleTree a -> + DTree a -> Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int])) dtToAdjRootParentEither root par f (DT x l r) = do i <- f x @@ -220,7 +220,7 @@ lastMap _ _ [] = [] lastMap f _ [x] = [f x] lastMap f g (x : xs) = g x : lastMap f g xs -prettyDT :: (a -> String) -> DoubleTree a -> [String] +prettyDT :: (a -> String) -> DTree a -> [String] prettyDT f (DT x l r) = concatMap (map ('/' :) . prettyDT f) r ++ (f x : concatMap (map ('\\' :) . prettyDT f) l) diff --git a/src/Dodge/Item/Grammar.hs b/src/Dodge/Item/Grammar.hs index 85aa636ed..866728bf2 100644 --- a/src/Dodge/Item/Grammar.hs +++ b/src/Dodge/Item/Grammar.hs @@ -246,7 +246,7 @@ invLDT' = fmap propagateOrientation . invLDT -- 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 :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item) invRootMap = foldMap (dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT)