module Annotations.F.Zipper
( Zipper(..), enter, leave, child, allFoci, Nav(..),
) where
import Annotations.F.Fixpoints
import Data.Foldable
import Data.Maybe
import Control.Monad
import Data.Monoid
data Zipper a = Zipper
{ zFocus :: a
, zUp :: Maybe (Zipper a)
, zLeft :: Maybe (Zipper a)
, zRight :: Maybe (Zipper a)
, zDown :: Maybe (Zipper a)
}
newtype Nav = Nav { nav :: forall a. Zipper a -> Maybe (Zipper a) }
instance Monoid Nav where
mempty = Nav return
mappend (Nav n1) (Nav n2) = Nav (n1 >=> n2)
enter :: Foldable f => Fix f -> Zipper (Fix f)
enter f = fromJust (enter' Nothing Nothing [f])
enter' :: Foldable f =>
Maybe (Zipper (Fix f)) ->
Maybe (Zipper (Fix f)) ->
[Fix f] ->
Maybe (Zipper (Fix f))
enter' _ _ [] = Nothing
enter' up left (focus@(In f) : fs) = here
where
here = Just (Zipper focus up left right down)
right = enter' up here fs
down = enter' here Nothing (toList f)
leave :: Zipper a -> a
leave z = maybe (zFocus z) leave (zUp z)
child :: Int -> Zipper a -> Maybe (Zipper a)
child 0 = zDown
child n = child (n 1) >=> zRight
allFoci :: Foldable f => Fix f -> [Zipper (Fix f)]
allFoci = allFoci' . enter
allFoci' :: Foldable f => Zipper (Fix f) -> [Zipper (Fix f)]
allFoci' z = z : [ z'' | Just z' <- [zDown z, zRight z], z'' <- allFoci' z' ]