module Annotations.MultiRec.ZipperFix (
Nav, FixZipper,
down, down', up, right, left,
dfnext, dfprev,
leave,
) where
import Annotations.MultiRec.Zipper
import Generics.MultiRec.HFix
import Prelude hiding (last)
import Data.Maybe
type FixZipper phi f = Loc phi f (HFix f)
type Nav = forall phi f ix. Zipper phi f =>
FixZipper phi f ix -> Maybe (FixZipper phi f ix)
down :: Nav
down' :: Nav
up :: Nav
right :: Nav
left :: Nav
down (Loc p (HIn x) s ) = first (\p' z c -> Loc p' z (Push p c s)) x
down' (Loc p (HIn x) s ) = last (\p' z c -> Loc p' z (Push p c s)) x
up (Loc p x Empty ) = Nothing
up (Loc p x (Push p' c s)) = return (Loc p' (HIn $ fill p c x) s)
right (Loc p x Empty ) = Nothing
right (Loc p x (Push p' c s)) = next (\p z c' -> Loc p z (Push p' c' s)) p c x
left (Loc p x Empty ) = Nothing
left (Loc p x (Push p' c s)) = prev (\p z c' -> Loc p z (Push p' c' s)) p c x
df :: (a -> Maybe a) -> (a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
df d u lr l =
case d l of
Nothing -> df' l
r -> r
where
df' l =
case lr l of
Nothing ->
case u l of
Nothing -> Nothing
Just l' -> df' l'
r -> r
dfnext :: Nav
dfnext = df down up right
dfprev :: Nav
dfprev = df down' up left
leave :: Zipper phi f => Loc phi f (HFix f) ix -> HFix f ix
leave (Loc p x Empty) = x
leave loc = leave (fromJust (up loc))