Data.Tree based on Data.Seq

SeqTree.hs

{-# LANGUAGE DeriveFunctor #-}
module Browser.SeqTree where

import qualified Data.Sequence as S

data SeqTree a
    = SeqTree
    { stLabel :: a
    , stForrest :: SeqForrest a
    } deriving (Read, Show, Functor)

type SeqForrest a = S.Seq (SeqTree a)


indexF :: Int -> [Int] -> SeqForrest a -> Maybe a
indexF i is' s = S.lookup i s >>= indexT is'

indexT :: [Int] -> SeqTree a -> Maybe a
indexT is t = case is of
    []      -> Just $ stLabel t
    i : is' -> indexF i is' (stForrest t)

adjustF :: (a -> a) -> Int -> [Int] -> SeqForrest a -> SeqForrest a
adjustF f i is' = S.adjust (adjustT f is') i

adjustT :: (a -> a) -> [Int] -> SeqTree a -> SeqTree a
adjustT f is t = case is of
    []      -> SeqTree (f $ stLabel t) (stForrest t)
    i : is' -> SeqTree (stLabel t) $ adjustF f i is' $ stForrest t

deleteAtF :: Int -> [Int] -> SeqForrest a -> SeqForrest a
deleteAtF i is = case is of
    []       -> S.deleteAt i
    i' : is' -> S.adjust (deleteAtT i' is') i

deleteAtT :: Int -> [Int] -> SeqTree a -> SeqTree a
deleteAtT i is t = SeqTree (stLabel t) $ del $ stForrest t
  where
    del = case is of
        []       -> S.deleteAt i
        i' : is' -> deleteAtF i' is'

insertAtF :: Int -> [Int] -> a -> SeqForrest a -> SeqForrest a
insertAtF i is x = case is of
    []       -> S.insertAt i (SeqTree x S.empty)
    i' : is' -> S.adjust (insertAtT i' is' x) i

insertAtT :: Int -> [Int] -> a -> SeqTree a -> SeqTree a
insertAtT i is x t = SeqTree (stLabel t) $ insertAtF i is x $ stForrest t