{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} module Data.List.NonEmpty.Zipper ( Zipper -- * Accessors , lefts , rights , current -- * Traversal , left , right , findLeft , findRight , start , end -- * Construction , fromNonEmpty , fromNonEmptyEnd -- ** Update , replace , delete , push , pop , shift , unshift , reverse -- * Predicates , 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 -- | The list zipper is a basic comonad -- -- This instance allows us to create a zipper of all possible states of -- traversing the zipper with 'left' and 'right'. -- -- >>> duplicate $ fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [] (Zipper [] 1 [2,3]) [Zipper [1] 2 [3],Zipper [2,1] 3 []] -- 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) -- | Get the current focus of the @'Zipper'@ cursor -- -- This is a synonym for 'Control.Comonad.extract' -- -- >>> current . fromNonEmpty $ NE.fromList [1, 2, 3] -- 1 -- current :: Zipper a -> a current :: Zipper a -> a current (Zipper [a] _ a curr [a] _) = a curr -- | Get all values on the left of the cursor -- -- >>> lefts . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- [1,2] -- lefts :: Zipper a -> [a] lefts :: Zipper a -> [a] lefts (Zipper [a] ls a _ [a] _) = [a] -> [a] forall a. [a] -> [a] Prelude.reverse [a] ls -- | Get all values on the right of the cursor -- -- >>> rights . fromNonEmpty $ NE.fromList [1, 2, 3] -- [2,3] -- rights :: Zipper a -> [a] rights :: Zipper a -> [a] rights (Zipper [a] _ a _ [a] rs) = [a] rs -- | Move the current focus of the cursor to the left -- -- >>> left . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- Just (Zipper [1] 2 [3]) -- 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) -- | Move the current focus of the cursor to the right -- -- >>> right . fromNonEmpty $ NE.fromList [1, 2, 3] -- Just (Zipper [1] 2 [3]) -- 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) -- | Move the current focus of the cursor to the first occurence of a value on the left -- -- >>> findLeft 2 . fromNonEmptyEnd $ NE.fromList [2, 1, 2, 1, 1, 3] -- Just (Zipper [1,2] 2 [1,1,3]) -- 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)) -- | Move the current focus of the cursor to the first occurence of a value on the right -- -- >>> findRight 3 . fromNonEmpty $ NE.fromList [2, 1, 3, 1, 1, 3] -- Just (Zipper [1,2] 3 [1,1,3]) -- 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) -- | Move the current focus of the cursor to the start of the @'Zipper'@ -- -- >>> start . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- Zipper [] 1 [2,3] -- 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 -- | Move the current focus of the cursor to the end of the @'Zipper'@ -- -- >>> end . fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [2,1] 3 [] -- 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 the current item under the curosr -- -- >>> replace 4 . fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [] 4 [2,3] -- 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 the item currently under the cursor -- -- The item currently under the cursor is removed. The cursors focus will move -- right. If at the end of the @'Zipper'@ the cursor will move left. -- -- >>> delete . fromNonEmpty $ NE.fromList [1, 2, 3] -- Just (Zipper [] 2 [3]) -- -- >>> delete . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- Just (Zipper [1] 2 []) -- 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 -- | Insert a value to the left of the cursor -- -- >>> push 0 . fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [0] 1 [2,3] -- 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 -- | Remove a value to the left of the cursor -- -- >>> pop . fromNonEmpty $ NE.fromList [1, 2, 3] -- (Zipper [] 1 [2,3],Nothing) -- -- >>> pop . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- (Zipper [1] 3 [],Just 2) -- 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) -- | Remove a value to the right of the cursor -- -- >>> shift . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- (Zipper [2,1] 3 [],Nothing) -- -- >>> shift . fromNonEmpty $ NE.fromList [1, 2, 3] -- (Zipper [] 1 [3],Just 2) -- 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) -- | Insert a value to the right of the cursor -- -- >>> unshift 4 . fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [] 1 [4,2,3] -- 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 the zipper keeping the cursor focus intact -- -- >>> reverse . fromNonEmpty $ NE.fromList [1, 2, 3] -- Zipper [2,3] 1 [] -- 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 -- | Determine if the @'Zipper'@ is at the beginning -- -- >>> isStart . fromNonEmpty $ NE.fromList [1, 2, 3] -- True -- -- >>> isStart . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- False -- isStart :: Zipper a -> Bool isStart :: Zipper a -> Bool isStart (Zipper [] a _ [a] _) = Bool True isStart Zipper a _ = Bool False -- | Determine if the @'Zipper'@ is at the end -- -- >>> isEnd . fromNonEmptyEnd $ NE.fromList [1, 2, 3] -- True -- -- >>> isEnd . fromNonEmpty $ NE.fromList [1, 2, 3] -- False -- isEnd :: Zipper a -> Bool isEnd :: Zipper a -> Bool isEnd (Zipper [a] _ a _ []) = Bool True isEnd Zipper a _ = Bool False