{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
module Data.List.NonEmpty.Zipper
( Zipper
, lefts
, rights
, current
, left
, right
, findLeft
, findRight
, start
, end
, fromNonEmpty
, fromNonEmptyEnd
, replace
, delete
, push
, pop
, shift
, unshift
, reverse
, isStart
, isEnd
)
where
import Prelude hiding (reverse)
import qualified Prelude
import Control.Comonad
import Control.DeepSeq (NFData)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Safe (headMay, tailMay)
data Zipper a = Zipper [a] a [a]
deriving stock (Zipper a -> Zipper a -> Bool
(Zipper a -> Zipper a -> Bool)
-> (Zipper a -> Zipper a -> Bool) -> Eq (Zipper a)
forall a. Eq a => Zipper a -> Zipper a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Zipper a -> Zipper a -> Bool
$c/= :: forall a. Eq a => Zipper a -> Zipper a -> Bool
== :: Zipper a -> Zipper a -> Bool
$c== :: forall a. Eq a => Zipper a -> Zipper a -> Bool
Eq, Int -> Zipper a -> ShowS
[Zipper a] -> ShowS
Zipper a -> String
(Int -> Zipper a -> ShowS)
-> (Zipper a -> String) -> ([Zipper a] -> ShowS) -> Show (Zipper a)
forall a. Show a => Int -> Zipper a -> ShowS
forall a. Show a => [Zipper a] -> ShowS
forall a. Show a => Zipper a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Zipper a] -> ShowS
$cshowList :: forall a. Show a => [Zipper a] -> ShowS
show :: Zipper a -> String
$cshow :: forall a. Show a => Zipper a -> String
showsPrec :: Int -> Zipper a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Zipper a -> ShowS
Show, a -> Zipper b -> Zipper a
(a -> b) -> Zipper a -> Zipper b
(forall a b. (a -> b) -> Zipper a -> Zipper b)
-> (forall a b. a -> Zipper b -> Zipper a) -> Functor Zipper
forall a b. a -> Zipper b -> Zipper a
forall a b. (a -> b) -> Zipper a -> Zipper b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Zipper b -> Zipper a
$c<$ :: forall a b. a -> Zipper b -> Zipper a
fmap :: (a -> b) -> Zipper a -> Zipper b
$cfmap :: forall a b. (a -> b) -> Zipper a -> Zipper b
Functor, (forall x. Zipper a -> Rep (Zipper a) x)
-> (forall x. Rep (Zipper a) x -> Zipper a) -> Generic (Zipper a)
forall x. Rep (Zipper a) x -> Zipper a
forall x. Zipper a -> Rep (Zipper a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Zipper a) x -> Zipper a
forall a x. Zipper a -> Rep (Zipper a) x
$cto :: forall a x. Rep (Zipper a) x -> Zipper a
$cfrom :: forall a x. Zipper a -> Rep (Zipper a) x
Generic)
deriving anyclass (Zipper a -> ()
(Zipper a -> ()) -> NFData (Zipper a)
forall a. NFData a => Zipper a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Zipper a -> ()
$crnf :: forall a. NFData a => Zipper a -> ()
NFData)
instance Foldable Zipper where
foldMap :: (a -> m) -> Zipper a -> m
foldMap a -> m
f (Zipper [a]
ls a
x [a]
rs) = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
ls) m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
rs
instance Traversable Zipper where
traverse :: (a -> f b) -> Zipper a -> f (Zipper b)
traverse a -> f b
f (Zipper [a]
ls a
x [a]
rs) =
[b] -> b -> [b] -> Zipper b
forall a. [a] -> a -> [a] -> Zipper a
Zipper
([b] -> b -> [b] -> Zipper b) -> f [b] -> f (b -> [b] -> Zipper b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([b] -> [b]
forall a. [a] -> [a]
Prelude.reverse ([b] -> [b]) -> f [b] -> f [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f ([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
ls))
f (b -> [b] -> Zipper b) -> f b -> f ([b] -> Zipper b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
x
f ([b] -> Zipper b) -> f [b] -> f (Zipper b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
rs
instance Comonad Zipper where
extract :: Zipper a -> a
extract = Zipper a -> a
forall a. Zipper a -> a
current
duplicate :: Zipper a -> Zipper (Zipper a)
duplicate Zipper a
z =
let dupWith :: (t -> Maybe t) -> t -> [t]
dupWith t -> Maybe t
f t
r =
case t -> Maybe t
f t
r of
Maybe t
Nothing -> [t
r]
Just t
x -> t
rt -> [t] -> [t]
forall a. a -> [a] -> [a]
:(t -> Maybe t) -> t -> [t]
dupWith t -> Maybe t
f t
x
in [Zipper a] -> Zipper a -> [Zipper a] -> Zipper (Zipper a)
forall a. [a] -> a -> [a] -> Zipper a
Zipper
([Zipper a]
-> (Zipper a -> [Zipper a]) -> Maybe (Zipper a) -> [Zipper a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Zipper a -> Maybe (Zipper a)) -> Zipper a -> [Zipper a]
forall t. (t -> Maybe t) -> t -> [t]
dupWith Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
left) (Maybe (Zipper a) -> [Zipper a]) -> Maybe (Zipper a) -> [Zipper a]
forall a b. (a -> b) -> a -> b
$ Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
left Zipper a
z)
Zipper a
z
([Zipper a]
-> (Zipper a -> [Zipper a]) -> Maybe (Zipper a) -> [Zipper a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Zipper a -> Maybe (Zipper a)) -> Zipper a -> [Zipper a]
forall t. (t -> Maybe t) -> t -> [t]
dupWith Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
right) (Maybe (Zipper a) -> [Zipper a]) -> Maybe (Zipper a) -> [Zipper a]
forall a b. (a -> b) -> a -> b
$ Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
right Zipper a
z)
current :: Zipper a -> a
current :: Zipper a -> a
current (Zipper [a]
_ a
curr [a]
_) = a
curr
lefts :: Zipper a -> [a]
lefts :: Zipper a -> [a]
lefts (Zipper [a]
ls a
_ [a]
_) = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
ls
rights :: Zipper a -> [a]
rights :: Zipper a -> [a]
rights (Zipper [a]
_ a
_ [a]
rs) = [a]
rs
left :: Zipper a -> Maybe (Zipper a)
left :: Zipper a -> Maybe (Zipper a)
left (Zipper [a]
ps a
curr [a]
ns) = do
a
newCurr <- [a] -> Maybe a
forall a. [a] -> Maybe a
headMay [a]
ps
Zipper a -> Maybe (Zipper a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Zipper a -> Maybe (Zipper a)) -> Zipper a -> Maybe (Zipper a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
tailMay [a]
ps) a
newCurr (a
curr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ns)
right :: Zipper a -> Maybe (Zipper a)
right :: Zipper a -> Maybe (Zipper a)
right (Zipper [a]
ps a
curr [a]
ns) = do
a
newCurr <- [a] -> Maybe a
forall a. [a] -> Maybe a
headMay [a]
ns
Zipper a -> Maybe (Zipper a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Zipper a -> Maybe (Zipper a)) -> Zipper a -> Maybe (Zipper a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper (a
curr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ps) a
newCurr ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [a] -> [a]) -> Maybe [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe [a]
forall a. [a] -> Maybe [a]
tailMay [a]
ns)
findLeft :: Eq a => a -> Zipper a -> Maybe (Zipper a)
findLeft :: a -> Zipper a -> Maybe (Zipper a)
findLeft a
target z :: Zipper a
z@(Zipper [a]
ps a
curr [a]
ns)
| a
curr a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
target = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z
| Bool
otherwise = case [a]
ps of
[] -> Maybe (Zipper a)
forall a. Maybe a
Nothing
(a
x : [a]
xs) -> a -> Zipper a -> Maybe (Zipper a)
forall a. Eq a => a -> Zipper a -> Maybe (Zipper a)
findLeft a
target ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
xs a
x (a
curr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ns))
findRight :: Eq a => a -> Zipper a -> Maybe (Zipper a)
findRight :: a -> Zipper a -> Maybe (Zipper a)
findRight a
target z :: Zipper a
z@(Zipper [a]
ps a
curr [a]
ns)
| a
curr a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
target = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just Zipper a
z
| Bool
otherwise = case [a]
ns of
[] -> Maybe (Zipper a)
forall a. Maybe a
Nothing
(a
x : [a]
xs) -> a -> Zipper a -> Maybe (Zipper a)
forall a. Eq a => a -> Zipper a -> Maybe (Zipper a)
findRight a
target ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper (a
curr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ps) a
x [a]
xs)
start :: Zipper a -> Zipper a
start :: Zipper a -> Zipper a
start Zipper a
z
| Zipper a -> Bool
forall a. Zipper a -> Bool
isStart Zipper a
z = Zipper a
z
| Bool
otherwise = NonEmpty a -> Zipper a
forall a. NonEmpty a -> Zipper a
fromNonEmpty (NonEmpty a -> Zipper a) -> NonEmpty a -> Zipper a
forall a b. (a -> b) -> a -> b
$ Zipper a -> NonEmpty a
forall a. Zipper a -> NonEmpty a
toNonEmpty Zipper a
z
end :: Zipper a -> Zipper a
end :: Zipper a -> Zipper a
end Zipper a
z
| Zipper a -> Bool
forall a. Zipper a -> Bool
isEnd Zipper a
z = Zipper a
z
| Bool
otherwise = NonEmpty a -> Zipper a
forall a. NonEmpty a -> Zipper a
fromNonEmptyEnd (NonEmpty a -> Zipper a) -> NonEmpty a -> Zipper a
forall a b. (a -> b) -> a -> b
$ Zipper a -> NonEmpty a
forall a. Zipper a -> NonEmpty a
toNonEmpty Zipper a
z
fromNonEmpty :: NE.NonEmpty a -> Zipper a
fromNonEmpty :: NonEmpty a -> Zipper a
fromNonEmpty NonEmpty a
ne = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [] (NonEmpty a -> a
forall a. NonEmpty a -> a
NE.head NonEmpty a
ne) (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty a
ne)
fromNonEmptyEnd :: NE.NonEmpty a -> Zipper a
fromNonEmptyEnd :: NonEmpty a -> Zipper a
fromNonEmptyEnd NonEmpty a
ne = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty a
reversed) (NonEmpty a -> a
forall a. NonEmpty a -> a
NE.head NonEmpty a
reversed) []
where reversed :: NonEmpty a
reversed = NonEmpty a -> NonEmpty a
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty a
ne
toNonEmpty :: Zipper a -> NE.NonEmpty a
toNonEmpty :: Zipper a -> NonEmpty a
toNonEmpty (Zipper [a]
ls a
x [a]
rs) = [a] -> NonEmpty a
forall a. [a] -> NonEmpty a
NE.fromList ([a] -> NonEmpty a) -> [a] -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
ls [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rs
replace :: a -> Zipper a -> Zipper a
replace :: a -> Zipper a -> Zipper a
replace a
x (Zipper [a]
ls a
_ [a]
rs) = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
x [a]
rs
delete :: Zipper a -> Maybe (Zipper a)
delete :: Zipper a -> Maybe (Zipper a)
delete (Zipper [] a
_ []) = Maybe (Zipper a)
forall a. Maybe a
Nothing
delete (Zipper [a]
ls a
_ (a
r : [a]
rs)) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Zipper a -> Maybe (Zipper a)) -> Zipper a -> Maybe (Zipper a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
r [a]
rs
delete (Zipper (a
l : [a]
ls) a
_ [a]
rs) = Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just (Zipper a -> Maybe (Zipper a)) -> Zipper a -> Maybe (Zipper a)
forall a b. (a -> b) -> a -> b
$ [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
l [a]
rs
push :: a -> Zipper a -> Zipper a
push :: a -> Zipper a -> Zipper a
push a
l (Zipper [a]
ls a
x [a]
rs) = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper (a
l a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ls) a
x [a]
rs
pop :: Zipper a -> (Zipper a, Maybe a)
pop :: Zipper a -> (Zipper a, Maybe a)
pop (Zipper [] a
x [a]
rs) = ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [] a
x [a]
rs, Maybe a
forall a. Maybe a
Nothing)
pop (Zipper (a
l : [a]
ls) a
x [a]
rs) = ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
x [a]
rs, a -> Maybe a
forall a. a -> Maybe a
Just a
l)
shift :: Zipper a -> (Zipper a, Maybe a)
shift :: Zipper a -> (Zipper a, Maybe a)
shift (Zipper [a]
ls a
x []) = ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
x [], Maybe a
forall a. Maybe a
Nothing)
shift (Zipper [a]
ls a
x (a
r : [a]
rs)) = ([a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
x [a]
rs, a -> Maybe a
forall a. a -> Maybe a
Just a
r)
unshift :: a -> Zipper a -> Zipper a
unshift :: a -> Zipper a -> Zipper a
unshift a
r (Zipper [a]
ls a
x [a]
rs) = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
ls a
x (a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rs)
reverse :: Zipper a -> Zipper a
reverse :: Zipper a -> Zipper a
reverse (Zipper [a]
ls a
x [a]
rs) = [a] -> a -> [a] -> Zipper a
forall a. [a] -> a -> [a] -> Zipper a
Zipper [a]
rs a
x [a]
ls
isStart :: Zipper a -> Bool
isStart :: Zipper a -> Bool
isStart (Zipper [] a
_ [a]
_) = Bool
True
isStart Zipper a
_ = Bool
False
isEnd :: Zipper a -> Bool
isEnd :: Zipper a -> Bool
isEnd (Zipper [a]
_ a
_ []) = Bool
True
isEnd Zipper a
_ = Bool
False