71 lines
1.7 KiB
Haskell
71 lines
1.7 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
--{-# LANGUAGE StrictData #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Dodge.Data.DoubleTree where
|
|
|
|
import Control.Lens
|
|
|
|
data DoubleTreeNodeType
|
|
= DTRootNode
|
|
| DTTopNode
|
|
| DTMidAboveNode
|
|
| DTMidBelowNode
|
|
| DTBottomNode
|
|
|
|
data DTree a = DT {_dtValue :: a, _dtLeft :: [DTree a], _dtRight :: [DTree a]}
|
|
deriving (Eq, Ord, Show, Read)
|
|
|
|
instance Functor DTree where
|
|
fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r)
|
|
|
|
instance Foldable DTree where
|
|
foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r
|
|
|
|
data ContextDT a
|
|
= TopDT
|
|
| LeftwardDT
|
|
{ _cdtUp :: ContextDT a
|
|
, _cdtCloseLeft :: [DTree a]
|
|
, _cdtParent :: a
|
|
, _cdtCloseRight :: [DTree a]
|
|
, _cdtFarRight :: [DTree a]
|
|
}
|
|
| RightwardDT
|
|
{ _cdtUp :: ContextDT a
|
|
, _cdtFarLeft :: [ DTree a]
|
|
, _cdtCloseLeft :: [DTree a]
|
|
, _cdtParent :: a
|
|
, _cdtCloseRight :: [DTree a]
|
|
}
|
|
|
|
data LocationDT a = LocDT
|
|
{ _locDtContext :: ContextDT a
|
|
, _locDT :: DTree a
|
|
}
|
|
|
|
makeLenses ''DTree
|
|
makeLenses ''LocationDT
|
|
makeLenses ''ContextDT
|
|
|
|
instance Functor LocationDT where
|
|
fmap f (LocDT c t) = LocDT (fmap f c) (fmap f t)
|
|
|
|
instance Functor ContextDT where
|
|
fmap f = \case
|
|
TopDT -> TopDT
|
|
LeftwardDT u cl p cr fr -> LeftwardDT
|
|
(fmap f u)
|
|
(fmap (fmap f) cl)
|
|
(f p)
|
|
(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)
|
|
(f p)
|
|
(fmap (fmap f) cr)
|
|
|
|
--deriveJSON defaultOptions ''DoubleTree
|
|
--deriveJSON defaultOptions ''LabelDoubleTree
|