module Data.Generics.Uniplate.Zipper(
Zipper, zipper, zipperBi, fromZipper,
left, right, up, down,
hole, replaceHole
) where
import Data.Generics.Uniplate.Operations
import Data.Generics.Str
import Control.Monad
import Data.Maybe
zipper :: Uniplate to => to -> Zipper to to
zipper :: forall to. Uniplate to => to -> Zipper to to
zipper = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall to from.
Uniplate to =>
(from -> (Str to, Str to -> from))
-> from -> Maybe (Zipper from to)
toZipper (\to
x -> (forall a. a -> Str a
One to
x, \(One to
x) -> to
x))
zipperBi :: Biplate from to => from -> Maybe (Zipper from to)
zipperBi :: forall from to. Biplate from to => from -> Maybe (Zipper from to)
zipperBi = forall to from.
Uniplate to =>
(from -> (Str to, Str to -> from))
-> from -> Maybe (Zipper from to)
toZipper forall from to. Biplate from to => from -> (Str to, Str to -> from)
biplate
data Zipper from to = Zipper
{forall from to. Zipper from to -> Str to -> from
reform :: Str to -> from
,forall from to. Zipper from to -> ZipN to
zipp :: ZipN to
}
rezipp :: (ZipN to -> f (ZipN to)) -> Zipper from to -> f (Zipper from to)
rezipp ZipN to -> f (ZipN to)
f (Zipper Str to -> from
a ZipN to
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. (Str to -> from) -> ZipN to -> Zipper from to
Zipper Str to -> from
a) forall a b. (a -> b) -> a -> b
$ ZipN to -> f (ZipN to)
f ZipN to
b
instance (Eq from, Eq to) => Eq (Zipper from to) where
Zipper from to
a == :: Zipper from to -> Zipper from to -> Bool
== Zipper from to
b = forall from to. Zipper from to -> from
fromZipper Zipper from to
a forall a. Eq a => a -> a -> Bool
== forall from to. Zipper from to -> from
fromZipper Zipper from to
b Bool -> Bool -> Bool
&& forall from to. Zipper from to -> ZipN to
zipp Zipper from to
a forall a. Eq a => a -> a -> Bool
== forall from to. Zipper from to -> ZipN to
zipp Zipper from to
b
toZipper :: Uniplate to => (from -> (Str to, Str to -> from)) -> from -> Maybe (Zipper from to)
toZipper :: forall to from.
Uniplate to =>
(from -> (Str to, Str to -> from))
-> from -> Maybe (Zipper from to)
toZipper from -> (Str to, Str to -> from)
biplate from
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall from to. (Str to -> from) -> ZipN to -> Zipper from to
Zipper Str to -> from
gen) forall a b. (a -> b) -> a -> b
$ forall x. Str x -> Maybe (ZipN x)
zipN Str to
cs
where (Str to
cs,Str to -> from
gen) = from -> (Str to, Str to -> from)
biplate from
x
fromZipper :: Zipper from to -> from
fromZipper :: forall from to. Zipper from to -> from
fromZipper Zipper from to
x = forall from to. Zipper from to -> Str to -> from
reform Zipper from to
x forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> Str a
top1 forall a b. (a -> b) -> a -> b
$ forall {x}. ZipN x -> Zip1 x
topN forall a b. (a -> b) -> a -> b
$ forall from to. Zipper from to -> ZipN to
zipp Zipper from to
x
left :: Zipper from to -> Maybe (Zipper from to)
left :: forall from to. Zipper from to -> Maybe (Zipper from to)
left = forall {f :: * -> *} {to} {from}.
Functor f =>
(ZipN to -> f (ZipN to)) -> Zipper from to -> f (Zipper from to)
rezipp forall {x}. ZipN x -> Maybe (ZipN x)
leftN
right :: Zipper from to -> Maybe (Zipper from to)
right :: forall from to. Zipper from to -> Maybe (Zipper from to)
right = forall {f :: * -> *} {to} {from}.
Functor f =>
(ZipN to -> f (ZipN to)) -> Zipper from to -> f (Zipper from to)
rezipp forall {x}. ZipN x -> Maybe (ZipN x)
rightN
down :: Uniplate to => Zipper from to -> Maybe (Zipper from to)
down :: forall to from.
Uniplate to =>
Zipper from to -> Maybe (Zipper from to)
down = forall {f :: * -> *} {to} {from}.
Functor f =>
(ZipN to -> f (ZipN to)) -> Zipper from to -> f (Zipper from to)
rezipp forall x. Uniplate x => ZipN x -> Maybe (ZipN x)
downN
up :: Zipper from to -> Maybe (Zipper from to)
up :: forall from to. Zipper from to -> Maybe (Zipper from to)
up = forall {f :: * -> *} {to} {from}.
Functor f =>
(ZipN to -> f (ZipN to)) -> Zipper from to -> f (Zipper from to)
rezipp forall {x}. ZipN x -> Maybe (ZipN x)
upN
hole :: Zipper from to -> to
hole :: forall from to. Zipper from to -> to
hole = forall {a}. ZipN a -> a
holeN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. Zipper from to -> ZipN to
zipp
replaceHole :: to -> Zipper from to -> Zipper from to
replaceHole :: forall to from. to -> Zipper from to -> Zipper from to
replaceHole to
x Zipper from to
z = Zipper from to
z{zipp :: ZipN to
zipp=forall {x}. x -> ZipN x -> ZipN x
replaceN to
x (forall from to. Zipper from to -> ZipN to
zipp Zipper from to
z)}
data ZipN x = ZipN [Str x -> Zip1 x] (Zip1 x)
instance Eq x => Eq (ZipN x) where
x :: ZipN x
x@(ZipN [Str x -> Zip1 x]
_ Zip1 x
xx) == :: ZipN x -> ZipN x -> Bool
== y :: ZipN x
y@(ZipN [Str x -> Zip1 x]
_ Zip1 x
yy) = Zip1 x
xx forall a. Eq a => a -> a -> Bool
== Zip1 x
yy Bool -> Bool -> Bool
&& forall {x}. ZipN x -> Maybe (ZipN x)
upN ZipN x
x forall a. Eq a => a -> a -> Bool
== forall {x}. ZipN x -> Maybe (ZipN x)
upN ZipN x
y
zipN :: Str x -> Maybe (ZipN x)
zipN :: forall x. Str x -> Maybe (ZipN x)
zipN Str x
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN []) forall a b. (a -> b) -> a -> b
$ forall x. Str x -> Maybe (Zip1 x)
zip1 Str x
x
leftN :: ZipN x -> Maybe (ZipN x)
leftN (ZipN [Str x -> Zip1 x]
p Zip1 x
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN [Str x -> Zip1 x]
p) forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> Maybe (Zip1 a)
left1 Zip1 x
x
rightN :: ZipN x -> Maybe (ZipN x)
rightN (ZipN [Str x -> Zip1 x]
p Zip1 x
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN [Str x -> Zip1 x]
p) forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> Maybe (Zip1 a)
right1 Zip1 x
x
holeN :: ZipN a -> a
holeN (ZipN [Str a -> Zip1 a]
_ Zip1 a
x) = forall a. Zip1 a -> a
hole1 Zip1 a
x
replaceN :: x -> ZipN x -> ZipN x
replaceN x
v (ZipN [Str x -> Zip1 x]
p Zip1 x
x) = forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN [Str x -> Zip1 x]
p forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> a -> Zip1 a
replace1 Zip1 x
x x
v
upN :: ZipN x -> Maybe (ZipN x)
upN (ZipN [] Zip1 x
x) = forall a. Maybe a
Nothing
upN (ZipN (Str x -> Zip1 x
p:[Str x -> Zip1 x]
ps) Zip1 x
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN [Str x -> Zip1 x]
ps forall a b. (a -> b) -> a -> b
$ Str x -> Zip1 x
p forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> Str a
top1 Zip1 x
x
topN :: ZipN x -> Zip1 x
topN (ZipN [] Zip1 x
x) = Zip1 x
x
topN ZipN x
x = ZipN x -> Zip1 x
topN forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall {x}. ZipN x -> Maybe (ZipN x)
upN ZipN x
x
downN :: Uniplate x => ZipN x -> Maybe (ZipN x)
downN :: forall x. Uniplate x => ZipN x -> Maybe (ZipN x)
downN (ZipN [Str x -> Zip1 x]
ps Zip1 x
x) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall x. [Str x -> Zip1 x] -> Zip1 x -> ZipN x
ZipN forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> a -> Zip1 a
replace1 Zip1 x
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. Str x -> x
gen forall a. a -> [a] -> [a]
: [Str x -> Zip1 x]
ps) forall a b. (a -> b) -> a -> b
$ forall x. Str x -> Maybe (Zip1 x)
zip1 Str x
cs
where (Str x
cs,Str x -> x
gen) = forall on. Uniplate on => on -> (Str on, Str on -> on)
uniplate forall a b. (a -> b) -> a -> b
$ forall a. Zip1 a -> a
hole1 Zip1 x
x
data Diff1 a = TwoLeft (Str a) | TwoRight (Str a) deriving Diff1 a -> Diff1 a -> Bool
forall a. Eq a => Diff1 a -> Diff1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diff1 a -> Diff1 a -> Bool
$c/= :: forall a. Eq a => Diff1 a -> Diff1 a -> Bool
== :: Diff1 a -> Diff1 a -> Bool
$c== :: forall a. Eq a => Diff1 a -> Diff1 a -> Bool
Eq
undiff1 :: Str a -> Diff1 a -> Str a
undiff1 Str a
r (TwoLeft Str a
l) = forall a. Str a -> Str a -> Str a
Two Str a
l Str a
r
undiff1 Str a
l (TwoRight Str a
r) = forall a. Str a -> Str a -> Str a
Two Str a
l Str a
r
data Zip1 a = Zip1 [Diff1 a] a deriving Zip1 a -> Zip1 a -> Bool
forall a. Eq a => Zip1 a -> Zip1 a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zip1 a -> Zip1 a -> Bool
$c/= :: forall a. Eq a => Zip1 a -> Zip1 a -> Bool
== :: Zip1 a -> Zip1 a -> Bool
$c== :: forall a. Eq a => Zip1 a -> Zip1 a -> Bool
Eq
zip1 :: Str x -> Maybe (Zip1 x)
zip1 :: forall x. Str x -> Maybe (Zip1 x)
zip1 = forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
True []
insert1 :: Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 :: forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
leftmost [Diff1 a]
c Str a
Zero = forall a. Maybe a
Nothing
insert1 Bool
leftmost [Diff1 a]
c (One a
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [Diff1 a] -> a -> Zip1 a
Zip1 [Diff1 a]
c a
x
insert1 Bool
leftmost [Diff1 a]
c (Two Str a
l Str a
r) = if Bool
leftmost then Maybe (Zip1 a)
ll forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (Zip1 a)
rr else Maybe (Zip1 a)
rr forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe (Zip1 a)
ll
where ll :: Maybe (Zip1 a)
ll = forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
leftmost (forall a. Str a -> Diff1 a
TwoRight Str a
rforall a. a -> [a] -> [a]
:[Diff1 a]
c) Str a
l
rr :: Maybe (Zip1 a)
rr = forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
leftmost (forall a. Str a -> Diff1 a
TwoLeft Str a
lforall a. a -> [a] -> [a]
:[Diff1 a]
c) Str a
r
left1, right1 :: Zip1 a -> Maybe (Zip1 a)
left1 :: forall a. Zip1 a -> Maybe (Zip1 a)
left1 = forall a. Bool -> Zip1 a -> Maybe (Zip1 a)
move1 Bool
True
right1 :: forall a. Zip1 a -> Maybe (Zip1 a)
right1 = forall a. Bool -> Zip1 a -> Maybe (Zip1 a)
move1 Bool
False
move1 :: Bool -> Zip1 a -> Maybe (Zip1 a)
move1 :: forall a. Bool -> Zip1 a -> Maybe (Zip1 a)
move1 Bool
leftward (Zip1 [Diff1 a]
p a
x) = forall {a}. [Diff1 a] -> Str a -> Maybe (Zip1 a)
f [Diff1 a]
p forall a b. (a -> b) -> a -> b
$ forall a. a -> Str a
One a
x
where
f :: [Diff1 a] -> Str a -> Maybe (Zip1 a)
f [Diff1 a]
p Str a
x = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum forall a b. (a -> b) -> a -> b
$
[forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
False (forall a. Str a -> Diff1 a
TwoRight Str a
xforall a. a -> [a] -> [a]
:[Diff1 a]
ps) Str a
l | TwoLeft Str a
l:[Diff1 a]
ps <- [[Diff1 a]
p], Bool
leftward] forall a. [a] -> [a] -> [a]
++
[forall a. Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a)
insert1 Bool
True (forall a. Str a -> Diff1 a
TwoLeft Str a
xforall a. a -> [a] -> [a]
:[Diff1 a]
ps) Str a
r | TwoRight Str a
r:[Diff1 a]
ps <- [[Diff1 a]
p], Bool -> Bool
not Bool
leftward] forall a. [a] -> [a] -> [a]
++
[[Diff1 a] -> Str a -> Maybe (Zip1 a)
f [Diff1 a]
ps (Str a
x forall {a}. Str a -> Diff1 a -> Str a
`undiff1` Diff1 a
p) | Diff1 a
p:[Diff1 a]
ps <- [[Diff1 a]
p]]
top1 :: Zip1 a -> Str a
top1 :: forall a. Zip1 a -> Str a
top1 (Zip1 [Diff1 a]
p a
x) = forall a. [Diff1 a] -> Str a -> Str a
f [Diff1 a]
p (forall a. a -> Str a
One a
x)
where f :: [Diff1 a] -> Str a -> Str a
f :: forall a. [Diff1 a] -> Str a -> Str a
f [] Str a
x = Str a
x
f (Diff1 a
p:[Diff1 a]
ps) Str a
x = forall a. [Diff1 a] -> Str a -> Str a
f [Diff1 a]
ps (Str a
x forall {a}. Str a -> Diff1 a -> Str a
`undiff1` Diff1 a
p)
hole1 :: Zip1 a -> a
hole1 :: forall a. Zip1 a -> a
hole1 (Zip1 [Diff1 a]
_ a
x) = a
x
replace1 :: Zip1 a -> a -> Zip1 a
replace1 :: forall a. Zip1 a -> a -> Zip1 a
replace1 (Zip1 [Diff1 a]
p a
_) = forall a. [Diff1 a] -> a -> Zip1 a
Zip1 [Diff1 a]
p