module Matterhorn.Zipper
( Zipper
, fromList
, toList
, focus
, unsafeFocus
, left
, leftL
, right
, rightL
, findRight
, maybeFindRight
, updateListBy
, filterZipper
, maybeMapZipper
, isEmpty
, position
)
where
import Prelude ()
import Matterhorn.Prelude hiding (toList)
import Data.List ( elemIndex )
import Data.Maybe ( fromJust )
import qualified Data.Foldable as F
import qualified Data.Sequence as Seq
import qualified Data.CircularList as C
import Lens.Micro.Platform
data Zipper a b =
Zipper { Zipper a b -> CList b
zRing :: C.CList b
, Zipper a b -> Seq (a, Seq b)
zTrees :: Seq.Seq (a, Seq.Seq b)
}
instance F.Foldable (Zipper a) where
foldMap :: (a -> m) -> Zipper a a -> m
foldMap a -> m
f = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> (Zipper a a -> [a]) -> Zipper a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq a -> [a]) -> (Zipper a a -> Seq a) -> Zipper a a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Seq a] -> Seq a
forall a. Monoid a => [a] -> a
mconcat ([Seq a] -> Seq a)
-> (Zipper a a -> [Seq a]) -> Zipper a a -> Seq a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Seq (Seq a) -> [Seq a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Seq a) -> [Seq a])
-> (Zipper a a -> Seq (Seq a)) -> Zipper a a -> [Seq a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((a, Seq a) -> Seq a) -> Seq (a, Seq a) -> Seq (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Seq a) -> Seq a
forall a b. (a, b) -> b
snd (Seq (a, Seq a) -> Seq (Seq a))
-> (Zipper a a -> Seq (a, Seq a)) -> Zipper a a -> Seq (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Zipper a a -> Seq (a, Seq a)
forall a b. Zipper a b -> Seq (a, Seq b)
zTrees
instance Functor (Zipper a) where
fmap :: (a -> b) -> Zipper a a -> Zipper a b
fmap a -> b
f Zipper a a
z =
Zipper :: forall a b. CList b -> Seq (a, Seq b) -> Zipper a b
Zipper { zRing :: CList b
zRing = a -> b
f (a -> b) -> CList a -> CList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper a a -> CList a
forall a b. Zipper a b -> CList b
zRing Zipper a a
z
, zTrees :: Seq (a, Seq b)
zTrees = Zipper a a -> Seq (a, Seq a)
forall a b. Zipper a b -> Seq (a, Seq b)
zTrees Zipper a a
z Seq (a, Seq a)
-> (Seq (a, Seq a) -> Seq (a, Seq b)) -> Seq (a, Seq b)
forall a b. a -> (a -> b) -> b
& ASetter (Seq (a, Seq a)) (Seq (a, Seq b)) (a, Seq a) (a, Seq b)
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mappedASetter (Seq (a, Seq a)) (Seq (a, Seq b)) (a, Seq a) (a, Seq b)
-> ((a -> Identity b) -> (a, Seq a) -> Identity (a, Seq b))
-> (a -> Identity b)
-> Seq (a, Seq a)
-> Identity (Seq (a, Seq b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq a -> Identity (Seq b)) -> (a, Seq a) -> Identity (a, Seq b)
forall s t a b. Field2 s t a b => Lens s t a b
_2((Seq a -> Identity (Seq b)) -> (a, Seq a) -> Identity (a, Seq b))
-> ((a -> Identity b) -> Seq a -> Identity (Seq b))
-> (a -> Identity b)
-> (a, Seq a)
-> Identity (a, Seq b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Identity b) -> Seq a -> Identity (Seq b)
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mapped ((a -> Identity b) -> Seq (a, Seq a) -> Identity (Seq (a, Seq b)))
-> (a -> b) -> Seq (a, Seq a) -> Seq (a, Seq b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ a -> b
f
}
isEmpty :: Zipper a b -> Bool
isEmpty :: Zipper a b -> Bool
isEmpty = CList b -> Bool
forall a. CList a -> Bool
C.isEmpty (CList b -> Bool) -> (Zipper a b -> CList b) -> Zipper a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing
position :: (Eq b) => Zipper a b -> Maybe Int
position :: Zipper a b -> Maybe Int
position Zipper a b
z = do
b
f <- Zipper a b -> Maybe b
forall a b. Zipper a b -> Maybe b
focus Zipper a b
z
b -> [b] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex b
f ([b] -> Maybe Int) -> [b] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[b]] -> [b]) -> [[b]] -> [b]
forall a b. (a -> b) -> a -> b
$ ((a, [b]) -> [b]) -> [(a, [b])] -> [[b]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, [b]) -> [b]
forall a b. (a, b) -> b
snd ([(a, [b])] -> [[b]]) -> [(a, [b])] -> [[b]]
forall a b. (a -> b) -> a -> b
$ Zipper a b -> [(a, [b])]
forall a b. Zipper a b -> [(a, [b])]
toList Zipper a b
z
left :: Zipper a b -> Zipper a b
left :: Zipper a b -> Zipper a b
left Zipper a b
z = Zipper a b
z { zRing :: CList b
zRing = CList b -> CList b
forall a. CList a -> CList a
C.rotL (Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing Zipper a b
z) }
leftL :: Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
leftL :: (Zipper a b -> f (Zipper a b)) -> Zipper a b -> f (Zipper a b)
leftL = (Zipper a b -> Zipper a b)
-> (Zipper a b -> Zipper a b -> Zipper a b)
-> Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Zipper a b -> Zipper a b
forall a b. Zipper a b -> Zipper a b
left (\ Zipper a b
_ Zipper a b
b -> Zipper a b -> Zipper a b
forall a b. Zipper a b -> Zipper a b
right Zipper a b
b)
right :: Zipper a b -> Zipper a b
right :: Zipper a b -> Zipper a b
right Zipper a b
z = Zipper a b
z { zRing :: CList b
zRing = CList b -> CList b
forall a. CList a -> CList a
C.rotR (Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing Zipper a b
z) }
rightL :: Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
rightL :: (Zipper a b -> f (Zipper a b)) -> Zipper a b -> f (Zipper a b)
rightL = (Zipper a b -> Zipper a b)
-> (Zipper a b -> Zipper a b -> Zipper a b)
-> Lens (Zipper a b) (Zipper a b) (Zipper a b) (Zipper a b)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Zipper a b -> Zipper a b
forall a b. Zipper a b -> Zipper a b
right (\ Zipper a b
_ Zipper a b
b -> Zipper a b -> Zipper a b
forall a b. Zipper a b -> Zipper a b
left Zipper a b
b)
focus :: Zipper a b -> Maybe b
focus :: Zipper a b -> Maybe b
focus = CList b -> Maybe b
forall a. CList a -> Maybe a
C.focus (CList b -> Maybe b)
-> (Zipper a b -> CList b) -> Zipper a b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing
unsafeFocus :: Zipper a b -> b
unsafeFocus :: Zipper a b -> b
unsafeFocus = Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe b -> b) -> (Zipper a b -> Maybe b) -> Zipper a b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a b -> Maybe b
forall a b. Zipper a b -> Maybe b
focus
fromList :: (Eq b) => [(a, [b])] -> Zipper a b
fromList :: [(a, [b])] -> Zipper a b
fromList [(a, [b])]
xs =
let ts :: Seq (a, Seq b)
ts = [(a, Seq b)] -> Seq (a, Seq b)
forall a. [a] -> Seq a
Seq.fromList ([(a, Seq b)] -> Seq (a, Seq b)) -> [(a, Seq b)] -> Seq (a, Seq b)
forall a b. (a -> b) -> a -> b
$ [(a, [b])]
xs [(a, [b])] -> ([(a, [b])] -> [(a, Seq b)]) -> [(a, Seq b)]
forall a b. a -> (a -> b) -> b
& ASetter [(a, [b])] [(a, Seq b)] (a, [b]) (a, Seq b)
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mappedASetter [(a, [b])] [(a, Seq b)] (a, [b]) (a, Seq b)
-> (([b] -> Identity (Seq b)) -> (a, [b]) -> Identity (a, Seq b))
-> ([b] -> Identity (Seq b))
-> [(a, [b])]
-> Identity [(a, Seq b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([b] -> Identity (Seq b)) -> (a, [b]) -> Identity (a, Seq b)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (([b] -> Identity (Seq b)) -> [(a, [b])] -> Identity [(a, Seq b)])
-> ([b] -> Seq b) -> [(a, [b])] -> [(a, Seq b)]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ [b] -> Seq b
forall a. [a] -> Seq a
Seq.fromList
tsList :: [b]
tsList = Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq b -> [b]) -> Seq b -> [b]
forall a b. (a -> b) -> a -> b
$ [Seq b] -> Seq b
forall a. Monoid a => [a] -> a
mconcat ([Seq b] -> Seq b) -> [Seq b] -> Seq b
forall a b. (a -> b) -> a -> b
$ Seq (Seq b) -> [Seq b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Seq b) -> [Seq b]) -> Seq (Seq b) -> [Seq b]
forall a b. (a -> b) -> a -> b
$ (a, Seq b) -> Seq b
forall a b. (a, b) -> b
snd ((a, Seq b) -> Seq b) -> Seq (a, Seq b) -> Seq (Seq b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (a, Seq b)
ts
maybeFocus :: CList b -> CList b
maybeFocus = if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
tsList
then CList b -> CList b
forall a. a -> a
id
else Maybe (CList b) -> CList b
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (CList b) -> CList b)
-> (CList b -> Maybe (CList b)) -> CList b -> CList b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> CList b -> Maybe (CList b)
forall a. Eq a => a -> CList a -> Maybe (CList a)
C.rotateTo ([b]
tsList [b] -> Int -> b
forall a. [a] -> Int -> a
!! Int
0)
in Zipper :: forall a b. CList b -> Seq (a, Seq b) -> Zipper a b
Zipper { zRing :: CList b
zRing = CList b -> CList b
maybeFocus (CList b -> CList b) -> CList b -> CList b
forall a b. (a -> b) -> a -> b
$ [b] -> CList b
forall a. [a] -> CList a
C.fromList [b]
tsList
, zTrees :: Seq (a, Seq b)
zTrees = Seq (a, Seq b)
ts
}
toList :: Zipper a b -> [(a, [b])]
toList :: Zipper a b -> [(a, [b])]
toList Zipper a b
z = Seq (a, [b]) -> [(a, [b])]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (a, [b]) -> [(a, [b])]) -> Seq (a, [b]) -> [(a, [b])]
forall a b. (a -> b) -> a -> b
$ Zipper a b -> Seq (a, Seq b)
forall a b. Zipper a b -> Seq (a, Seq b)
zTrees Zipper a b
z Seq (a, Seq b) -> (Seq (a, Seq b) -> Seq (a, [b])) -> Seq (a, [b])
forall a b. a -> (a -> b) -> b
& ASetter (Seq (a, Seq b)) (Seq (a, [b])) (a, Seq b) (a, [b])
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mappedASetter (Seq (a, Seq b)) (Seq (a, [b])) (a, Seq b) (a, [b])
-> ((Seq b -> Identity [b]) -> (a, Seq b) -> Identity (a, [b]))
-> (Seq b -> Identity [b])
-> Seq (a, Seq b)
-> Identity (Seq (a, [b]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq b -> Identity [b]) -> (a, Seq b) -> Identity (a, [b])
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Seq b -> Identity [b])
-> Seq (a, Seq b) -> Identity (Seq (a, [b])))
-> (Seq b -> [b]) -> Seq (a, Seq b) -> Seq (a, [b])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Seq b -> [b]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
findRight :: (b -> Bool) -> Zipper a b -> Zipper a b
findRight :: (b -> Bool) -> Zipper a b -> Zipper a b
findRight b -> Bool
f Zipper a b
z = Zipper a b -> Maybe (Zipper a b) -> Zipper a b
forall a. a -> Maybe a -> a
fromMaybe Zipper a b
z (Maybe (Zipper a b) -> Zipper a b)
-> Maybe (Zipper a b) -> Zipper a b
forall a b. (a -> b) -> a -> b
$ (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
forall b a. (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
maybeFindRight b -> Bool
f Zipper a b
z
maybeFindRight :: (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
maybeFindRight :: (b -> Bool) -> Zipper a b -> Maybe (Zipper a b)
maybeFindRight b -> Bool
f Zipper a b
z = do
CList b
newRing <- (b -> Bool) -> CList b -> Maybe (CList b)
forall a. (a -> Bool) -> CList a -> Maybe (CList a)
C.findRotateTo b -> Bool
f (Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing Zipper a b
z)
Zipper a b -> Maybe (Zipper a b)
forall (m :: * -> *) a. Monad m => a -> m a
return Zipper a b
z { zRing :: CList b
zRing = CList b
newRing }
updateListBy :: (Eq b)
=> (Maybe b -> b -> Bool)
-> [(a, [b])]
-> Zipper a b
-> Zipper a b
updateListBy :: (Maybe b -> b -> Bool) -> [(a, [b])] -> Zipper a b -> Zipper a b
updateListBy Maybe b -> b -> Bool
f [(a, [b])]
newList Zipper a b
oldZip = (b -> Bool) -> Zipper a b -> Zipper a b
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
findRight (Maybe b -> b -> Bool
f (Zipper a b -> Maybe b
forall a b. Zipper a b -> Maybe b
focus Zipper a b
oldZip)) (Zipper a b -> Zipper a b) -> Zipper a b -> Zipper a b
forall a b. (a -> b) -> a -> b
$ [(a, [b])] -> Zipper a b
forall b a. Eq b => [(a, [b])] -> Zipper a b
fromList [(a, [b])]
newList
maybeMapZipper :: (Eq c) => (b -> Maybe c) -> Zipper a b -> Zipper a c
maybeMapZipper :: (b -> Maybe c) -> Zipper a b -> Zipper a c
maybeMapZipper b -> Maybe c
f Zipper a b
z =
let oldTrees :: Seq (a, Seq b)
oldTrees = Zipper a b -> Seq (a, Seq b)
forall a b. Zipper a b -> Seq (a, Seq b)
zTrees Zipper a b
z
newTrees :: [(a, [c])]
newTrees = Seq (a, [c]) -> [(a, [c])]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (a, [c]) -> [(a, [c])]) -> Seq (a, [c]) -> [(a, [c])]
forall a b. (a -> b) -> a -> b
$ Seq (a, Seq b)
oldTrees Seq (a, Seq b) -> (Seq (a, Seq b) -> Seq (a, [c])) -> Seq (a, [c])
forall a b. a -> (a -> b) -> b
& ASetter (Seq (a, Seq b)) (Seq (a, [c])) (a, Seq b) (a, [c])
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mappedASetter (Seq (a, Seq b)) (Seq (a, [c])) (a, Seq b) (a, [c])
-> ((Seq b -> Identity [c]) -> (a, Seq b) -> Identity (a, [c]))
-> (Seq b -> Identity [c])
-> Seq (a, Seq b)
-> Identity (Seq (a, [c]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq b -> Identity [c]) -> (a, Seq b) -> Identity (a, [c])
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Seq b -> Identity [c])
-> Seq (a, Seq b) -> Identity (Seq (a, [c])))
-> (Seq b -> [c]) -> Seq (a, Seq b) -> Seq (a, [c])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Maybe c] -> [c]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe c] -> [c]) -> (Seq b -> [Maybe c]) -> Seq b -> [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Maybe c) -> [Maybe c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq (Maybe c) -> [Maybe c])
-> (Seq b -> Seq (Maybe c)) -> Seq b -> [Maybe c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe c) -> Seq b -> Seq (Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe c
f)
in [(a, [c])] -> Zipper a c
forall b a. Eq b => [(a, [b])] -> Zipper a b
fromList [(a, [c])]
newTrees
filterZipper :: (Eq b) => (b -> Bool) -> Zipper a b -> Zipper a b
filterZipper :: (b -> Bool) -> Zipper a b -> Zipper a b
filterZipper b -> Bool
f Zipper a b
oldZip = Zipper a b -> Zipper a b
forall a. Zipper a b -> Zipper a b
maintainFocus Zipper a b
newZip
where maintainFocus :: Zipper a b -> Zipper a b
maintainFocus = (b -> Bool) -> Zipper a b -> Zipper a b
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
findRight ((Maybe b -> Maybe b -> Bool
forall a. Eq a => a -> a -> Bool
== Zipper a b -> Maybe b
forall a b. Zipper a b -> Maybe b
focus Zipper a b
oldZip) (Maybe b -> Bool) -> (b -> Maybe b) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just)
newZip :: Zipper a b
newZip = Zipper :: forall a b. CList b -> Seq (a, Seq b) -> Zipper a b
Zipper { zTrees :: Seq (a, Seq b)
zTrees = Zipper a b -> Seq (a, Seq b)
forall a b. Zipper a b -> Seq (a, Seq b)
zTrees Zipper a b
oldZip Seq (a, Seq b)
-> (Seq (a, Seq b) -> Seq (a, Seq b)) -> Seq (a, Seq b)
forall a b. a -> (a -> b) -> b
& ASetter (Seq (a, Seq b)) (Seq (a, Seq b)) (a, Seq b) (a, Seq b)
forall (f :: * -> *) a b. Functor f => ASetter (f a) (f b) a b
mappedASetter (Seq (a, Seq b)) (Seq (a, Seq b)) (a, Seq b) (a, Seq b)
-> ((Seq b -> Identity (Seq b))
-> (a, Seq b) -> Identity (a, Seq b))
-> (Seq b -> Identity (Seq b))
-> Seq (a, Seq b)
-> Identity (Seq (a, Seq b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq b -> Identity (Seq b)) -> (a, Seq b) -> Identity (a, Seq b)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Seq b -> Identity (Seq b))
-> Seq (a, Seq b) -> Identity (Seq (a, Seq b)))
-> (Seq b -> Seq b) -> Seq (a, Seq b) -> Seq (a, Seq b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (b -> Bool) -> Seq b -> Seq b
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter b -> Bool
f
, zRing :: CList b
zRing = (b -> Bool) -> CList b -> CList b
forall a. (a -> Bool) -> CList a -> CList a
C.filterR b -> Bool
f (Zipper a b -> CList b
forall a b. Zipper a b -> CList b
zRing Zipper a b
oldZip)
}