--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.List.Zipper
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module HGeometry.List.Zipper where

import qualified Data.List as List

--------------------------------------------------------------------------------

-- | Simple Zipper for Lists.
data Zipper a = Zipper [a] [a] deriving (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
$cshowsPrec :: forall a. Show a => Int -> Zipper a -> ShowS
showsPrec :: Int -> Zipper a -> ShowS
$cshow :: forall a. Show a => Zipper a -> String
show :: Zipper a -> String
$cshowList :: forall a. Show a => [Zipper a] -> ShowS
showList :: [Zipper a] -> ShowS
Show,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
$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
/= :: Zipper a -> Zipper a -> Bool
Eq,(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
$cfmap :: forall a b. (a -> b) -> Zipper a -> Zipper b
fmap :: forall a b. (a -> b) -> Zipper a -> Zipper b
$c<$ :: forall a b. a -> Zipper b -> Zipper a
<$ :: forall a b. a -> Zipper b -> Zipper a
Functor)

instance Foldable Zipper where
  -- Folds like it it is a normal list
  foldMap :: forall m a. Monoid m => (a -> m) -> Zipper a -> m
foldMap a -> m
f (Zipper [a]
ls [a]
rs) = (a -> m) -> [a] -> m
forall m a. Monoid m => (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]
reverse [a]
ls) m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
rs


-- | Construct a Zipper from a list
--
-- running time: \(O(1)\)
fromList :: [a] -> Zipper a
fromList :: forall a. [a] -> Zipper a
fromList = [a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper []

-- | Go to the Next Element
--
-- running time: \(O(1)\)
goNext                :: Zipper a -> Maybe (Zipper a)
goNext :: forall a. Zipper a -> Maybe (Zipper a)
goNext (Zipper [a]
xs [a]
ys) = case [a]
ys of
                          []    -> Maybe (Zipper a)
forall a. Maybe a
Nothing
                          a
x:[a]
ys' -> 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] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys'

-- | Go to the previous Element
--
-- running time: \(O(1)\)
goPrev                :: Zipper a -> Maybe (Zipper a)
goPrev :: forall a. Zipper a -> Maybe (Zipper a)
goPrev (Zipper [a]
xs [a]
ys) = case [a]
xs of
                          []    -> Maybe (Zipper a)
forall a. Maybe a
Nothing
                          a
x:[a]
xs' -> 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] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper [a]
xs' (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)

-- | Computes all nexts, even one that has no elements initially or at
-- the end.
--
-- >>> mapM_ print $ allNexts $ fromList [1..5]
-- Zipper [] [1,2,3,4,5]
-- Zipper [1] [2,3,4,5]
-- Zipper [2,1] [3,4,5]
-- Zipper [3,2,1] [4,5]
-- Zipper [4,3,2,1] [5]
-- Zipper [5,4,3,2,1] []
allNexts :: Zipper a -> [Zipper a]
allNexts :: forall a. Zipper a -> [Zipper a]
allNexts = (Maybe (Zipper a) -> Maybe (Zipper a, Maybe (Zipper a)))
-> Maybe (Zipper a) -> [Zipper a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr ((Zipper a -> (Zipper a, Maybe (Zipper a)))
-> Maybe (Zipper a) -> Maybe (Zipper a, Maybe (Zipper a))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Zipper a
z -> (Zipper a
z,Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goNext Zipper a
z))) (Maybe (Zipper a) -> [Zipper a])
-> (Zipper a -> Maybe (Zipper a)) -> Zipper a -> [Zipper a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a -> Maybe (Zipper a)
forall a. a -> Maybe a
Just

-- | Returns the next element, and the zipper without it
extractNext                :: Zipper a -> Maybe (a, Zipper a)
extractNext :: forall a. Zipper a -> Maybe (a, Zipper a)
extractNext (Zipper [a]
xs [a]
ys) = case [a]
ys of
                               []      -> Maybe (a, Zipper a)
forall a. Maybe a
Nothing
                               (a
y:[a]
ys') -> (a, Zipper a) -> Maybe (a, Zipper a)
forall a. a -> Maybe a
Just (a
y,[a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper [a]
xs [a]
ys')


-- | Drops the next element in the zipper.
--
-- running time: \(O(1)\)
dropNext :: Zipper a -> Maybe (Zipper a)
dropNext :: forall a. Zipper a -> Maybe (Zipper a)
dropNext = ((a, Zipper a) -> Zipper a)
-> Maybe (a, Zipper a) -> Maybe (Zipper a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Zipper a) -> Zipper a
forall a b. (a, b) -> b
snd (Maybe (a, Zipper a) -> Maybe (Zipper a))
-> (Zipper a -> Maybe (a, Zipper a))
-> Zipper a
-> Maybe (Zipper a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Zipper a -> Maybe (a, Zipper a)
forall a. Zipper a -> Maybe (a, Zipper a)
extractNext

-- | Computes all list that still have next elements.
--
-- >>> mapM_ print $ allNonEmptyNexts $ fromList [1..5]
-- Zipper [] [1,2,3,4,5]
-- Zipper [1] [2,3,4,5]
-- Zipper [2,1] [3,4,5]
-- Zipper [3,2,1] [4,5]
-- Zipper [4,3,2,1] [5]
allNonEmptyNexts :: Zipper a -> [Zipper a]
allNonEmptyNexts :: forall a. Zipper a -> [Zipper a]
allNonEmptyNexts = (Zipper a -> Maybe (Zipper a, Zipper a)) -> Zipper a -> [Zipper a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (\Zipper a
z -> (Zipper a
z,) (Zipper a -> (Zipper a, Zipper a))
-> Maybe (Zipper a) -> Maybe (Zipper a, Zipper a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Zipper a -> Maybe (Zipper a)
forall a. Zipper a -> Maybe (Zipper a)
goNext Zipper a
z)