list-zipper 0.0.1 → 0.0.2

raw patch · 3 files changed

+356/−256 lines, 3 filesdep +profunctorsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: profunctors

API changes (from Hackage documentation)

Files

• changelog.md +5/−0
• list-zipper.cabal +3/−2
• src/Data/ListZipper.hs +348/−254

@@ -1,3 +1,8 @@+0.0.2++* add `opUntil` and applications+* make `ListZipperOp` more general+ 0.0.1  * Initial release

@@ -1,5 +1,5 @@ name:               list-zipper-version:            0.0.1+version:            0.0.2 license:            BSD3 license-file:       LICENCE author:             Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>@@ -32,7 +32,8 @@                     , semigroupoids >= 5.2 && < 6                     , lens >= 4 && < 5                     , comonad >= 5.0 && < 6.0-                    +                    , profunctors >= 5.0 && < 6.0+   ghc-options:                     -Wall 

@@ -7,12 +7,32 @@  module Data.ListZipper(   ListZipper(..)+, AsListZipper(..)+, HasListZipper(..)+, leftz'+, rightz'+, leftzrightz+, rightzleftz+, zipper+, zipper0L+, zipper0L'+, zipper0R+, zipper0R'+, list+, zipperIndices+, moveStart+, moveEnd+, atStart+, atEnd+, moveLeftLoop+, moveRightLoop , ListZipperOp(..)+, ListZipperOp'+, HasListZipperOp(..)+, AsListZipperOp(..) , pureListZipperOp , unpureListZipperOp-, constListZipperOp , idListZipperOp-, (<||>) , (&^.) , moveLeft , moveRight@@ -21,45 +41,34 @@ , moveRightUntil , moveLeftRightUntil , moveRightLeftUntil+, opWith+, moveLeftWith+, moveRightWith+, moveLeftRightWith+, moveRightLeftWith , opWhileJust-, moveStart-, moveEnd-, atStart-, atEnd-, moveLeftLoop-, moveRightLoop , deleteStepLeft , deleteStepRight , insertMoveLeft , insertMoveRight-, AsListZipper(..)-, HasListZipper(..)-, lefts'-, rights'-, leftsrights-, rightslefts-, zipper-, zipper0L-, zipper0L'-, zipper0R-, zipper0R'-, list-, zipperIndices ) where -import Control.Applicative(Applicative(pure, (<*>)))+import Control.Applicative(Applicative(pure, (<*>)), Alternative((<|>), empty)) import Control.Category((.), id) import Control.Comonad(Comonad(duplicate, extract))-import Control.Lens hiding ((<.>))-import Control.Monad((>=>), (=<<))+import Control.Lens(Each(each), Reversing(reversing), Ixed(ix), Rewrapped, Wrapped(Unwrapped, _Wrapped'), IxValue, Index, Prism', Lens', Traversal', _Wrapped, (^.), iso, (&))+import Data.Traversable+import Data.Semigroup.Traversable+import Control.Monad(Monad((>>=), return), MonadPlus(mplus, mzero), (=<<)) import Data.Bool(Bool) import Data.Eq(Eq((==))) import Data.Eq.Deriving(deriveEq1) import Data.Foldable(Foldable(toList, foldMap)) import Data.Functor(Functor(fmap), (<$>))-import Data.Functor.Alt((<!>))+import Data.Functor.Alt(Alt((<!>))) import Data.Functor.Apply(Apply((<.>)))-import Data.Functor.Extend+import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Extend(Extend(duplicated)) import Data.Int(Int) import Data.List(unfoldr, zipWith, repeat, reverse, null, zip) import Data.List.NonEmpty(NonEmpty((:|)))@@ -70,6 +79,7 @@ import Data.Semigroup.Foldable(Foldable1(foldMap1)) import Prelude(Show, (+)) import Text.Show.Deriving(deriveShow1)+import Data.Profunctor(Profunctor(dimap, rmap))  data ListZipper a =   ListZipper @@ -164,78 +174,294 @@   extract (ListZipper _ x _) =     x -newtype ListZipperOp a =-  ListZipperOp-    (ListZipper a -> Maybe (ListZipper a))+class AsListZipper z a | z -> a where+  _ListZipper ::+    Prism' z (ListZipper a)+  +instance AsListZipper (ListZipper a) a where+  _ListZipper =+    id -instance ListZipperOp x ~ y =>-  Rewrapped (ListZipperOp w) y+class HasListZipper z a | z -> a where+  listZipper ::+    Lens' z (ListZipper a)+  focus ::+    Lens' z a+  {-# INLINE focus #-}+  leftz ::+    Lens' z [a]+  {-# INLINE leftz #-}+  rightz ::+    Lens' z [a]+  {-# INLINE rightz #-}+  leftz =+    listZipper . leftz+  focus =+    listZipper . focus+  rightz =+    listZipper . rightz -instance Wrapped (ListZipperOp x) where-  type Unwrapped (ListZipperOp x) =-    ListZipper x-    -> Maybe (ListZipper x)+instance HasListZipper (ListZipper a) a where+  {-# INLINE focus #-}+  {-# INLINE leftz #-}+  {-# INLINE rightz #-}+  listZipper =+    id+  leftz f (ListZipper l x r) =+    fmap (\l' -> ListZipper l' x r) (f l)+  focus f (ListZipper l x r) =+    fmap (\x' -> ListZipper l x' r) (f x)+  rightz f (ListZipper l x r) =+    fmap (\r' -> ListZipper l x r') (f r)++leftz' ::+  HasListZipper z a =>+  Traversal' z a+leftz' =+  leftz . traverse++rightz' ::+  HasListZipper z a =>+  Traversal' z a+rightz' =+  rightz . traverse++leftzrightz ::+  Traversal' (ListZipper a) a+leftzrightz f (ListZipper l x r) =+  (\l' r' -> ListZipper l' x r') <$> traverse f l <*> traverse f r++rightzleftz ::+  Traversal' (ListZipper a) a+rightzleftz f (ListZipper l x r) =+  (\r' l' -> ListZipper l' x r') <$> traverse f r <*> traverse f l++zipper ::+  [a]+  -> Maybe (ListZipper a)+zipper [] =+  Nothing+zipper (h:t) =+  Just (ListZipper [] h t)++zipper0L ::+  a+  -> [a]+  -> ListZipper a+zipper0L =+  ListZipper []++zipper0L' ::+  NonEmpty a+  -> ListZipper a+zipper0L' (h :| t) =+  zipper0L h t++zipper0R ::+  [a]+  -> a+  -> ListZipper a+zipper0R l x =+  ListZipper l x []++zipper0R' ::+  NonEmpty a+  -> ListZipper a+zipper0R' (h :| []) =+  ListZipper [] h []+zipper0R' (h :| i : t) =+  let ListZipper l x r = zipper0R' (i :| t)+  in  ListZipper (h:l) x r++list ::+  ListZipper a+  -> [a]+list (ListZipper l x r) =+  reverse l <> (x : r)++zipperIndices ::+  ListZipper a+  -> ListZipper (Int, a)+zipperIndices (ListZipper l x r) =+  let zipl ::+        [a]+        -> [b]+        -> ([a], [(a, b)])+      zipl y [] =+        (y, [])+      zipl [] (_:_) =+        ([], [])+      zipl (a:b) (c:d) =+        fmap ((a, c) :) (zipl b d)+      rl =+        reverse l+      (z, l') =+        zipl [0..] rl+      ln =+        case z of+          n:_ ->+            n+          [] ->+            0+  in  ListZipper+        (reverse l')+        (ln, x)+        (zip [ln + 1..] r)++moveStart ::+  ListZipper a+  -> ListZipper a+moveStart =+  opWhileJust moveLeft++moveEnd ::+  ListZipper a+  -> ListZipper a+moveEnd =+  opWhileJust moveRight++atStart ::+  HasListZipper z a =>+  z+  -> Bool+atStart z =+  null (z ^. leftz)++atEnd ::+  HasListZipper z a =>+  z+  -> Bool+atEnd z =+  null (z ^. rightz)++moveLeftLoop ::+  ListZipper a+  -> ListZipper a+moveLeftLoop z =+  fromMaybe (moveEnd z) (moveLeft &^. z)++moveRightLoop ::+  ListZipper a+  -> ListZipper a+moveRightLoop z =+  fromMaybe (moveStart z) (moveRight &^. z)++newtype ListZipperOp x y =+  ListZipperOp (ListZipper x -> Maybe y)++type ListZipperOp' x =+  ListZipperOp x (ListZipper x)++instance ListZipperOp x y ~ t =>+  Rewrapped (ListZipperOp x' y') t++instance Wrapped (ListZipperOp x' y') where+  type Unwrapped (ListZipperOp x' y') =+    ListZipper x'+    -> Maybe y'   _Wrapped' =-    iso-      (\(ListZipperOp x) -> x)-      ListZipperOp+    iso (\(ListZipperOp k) -> k) ListZipperOp -instance Semigroup (ListZipperOp a) where-  ListZipperOp x <> ListZipperOp y =-    ListZipperOp (x >=> y)+class HasListZipperOp lo x y | lo -> x y where+  lo ::+    Lens' lo (ListZipperOp x y) -instance Monoid (ListZipperOp a) where+instance HasListZipperOp (ListZipperOp x y) x y where+  lo =+    id++class AsListZipperOp t x y | t -> x y where+  _ListZipperOp :: Prism' t (ListZipperOp x y)++instance AsListZipperOp (ListZipperOp x y) x y where+  _ListZipperOp =+    id++instance Functor (ListZipperOp x) where+  fmap f (ListZipperOp k) =+    ListZipperOp (fmap f . k)++instance Apply (ListZipperOp x) where+  ListZipperOp j <.> ListZipperOp k =+    ListZipperOp (\z -> j z <.> k z)++instance Applicative (ListZipperOp x) where+  (<*>) =+    (<.>)+  pure =+    ListZipperOp . pure . pure++instance Bind (ListZipperOp x) where+  ListZipperOp j >>- f =+    ListZipperOp (\z -> j z >>- \a -> let ListZipperOp k = f a in k z)++instance Alt (ListZipperOp x) where+  ListZipperOp j <!> ListZipperOp k =+    ListZipperOp (\z -> j z <!> k z)++instance Alternative (ListZipperOp x) where+  (<|>) =+    (<!>)+  empty =+    ListZipperOp (pure empty)++instance Monad (ListZipperOp x) where+  (>>=) =+    (>>-)+  return =+    pure++instance MonadPlus (ListZipperOp x) where+  ListZipperOp j `mplus` ListZipperOp k =+    ListZipperOp (\z -> j z `mplus` k z)+  mzero =+    ListZipperOp (pure mzero)++instance Semigroup (ListZipperOp x y) where+  ListZipperOp j <> ListZipperOp k =+    ListZipperOp (\z -> j z <!> k z)++instance Monoid (ListZipperOp x y) where   mappend =     (<>)   mempty =     ListZipperOp (pure Nothing) +instance Profunctor ListZipperOp where+  dimap f g (ListZipperOp k) =+    ListZipperOp (fmap g . k . fmap f)+  rmap =+    fmap+ pureListZipperOp ::   (ListZipper a -> ListZipper a)-  -> ListZipperOp a+  -> ListZipperOp' a pureListZipperOp k =   ListZipperOp (Just . k)  unpureListZipperOp ::-  ListZipperOp a+  ListZipperOp' a   -> ListZipper a   -> ListZipper a unpureListZipperOp (ListZipperOp x) =   fromMaybe <*> x -constListZipperOp ::-  ListZipper a-  -> ListZipperOp a-constListZipperOp =-  pureListZipperOp . pure- idListZipperOp ::-  ListZipperOp a+  ListZipperOp' a idListZipperOp =   ListZipperOp Just -(<||>) ::-  ListZipperOp a-  -> ListZipperOp a-  -> ListZipperOp a-ListZipperOp x <||> ListZipperOp y =-  ListZipperOp (\z ->-    x z <!> y z  -  )--infixl 3 <||>- (&^.) ::-  ListZipperOp a-  -> ListZipper a-  -> Maybe (ListZipper a)+  ListZipperOp x y+  -> ListZipper x+  -> Maybe y (&^.) o z =   z & o ^. _Wrapped  infixr 5 &^.  moveLeft ::-  ListZipperOp a+  ListZipperOp' a moveLeft =   ListZipperOp (\z ->     case z of@@ -246,7 +472,7 @@   )  moveRight ::-  ListZipperOp a+  ListZipperOp' a moveRight =   ListZipperOp (\z ->     case z of@@ -257,9 +483,9 @@   )  opUntil ::-  ListZipperOp a+  ListZipperOp' a   -> (a -> Bool)-  -> ListZipperOp a+  -> ListZipperOp' a opUntil o p =   ListZipperOp (\z ->     let go z' =@@ -274,30 +500,70 @@  moveLeftUntil ::   (a -> Bool)-  -> ListZipperOp a+  -> ListZipperOp' a moveLeftUntil =   opUntil moveLeft  moveRightUntil ::   (a -> Bool)-  -> ListZipperOp a+  -> ListZipperOp' a moveRightUntil =   opUntil moveRight  moveLeftRightUntil ::   (a -> Bool)-  -> ListZipperOp a+  -> ListZipperOp' a moveLeftRightUntil p =-  moveLeftUntil p <||> moveRightUntil p+  moveLeftUntil p <!> moveRightUntil p  moveRightLeftUntil ::   (a -> Bool)-  -> ListZipperOp a+  -> ListZipperOp' a moveRightLeftUntil p =-  moveRightUntil p <||> moveLeftUntil p+  moveRightUntil p <!> moveLeftUntil p +opWith ::+  ListZipperOp' a+  -> (a -> Maybe b)+  -> ListZipperOp a (b, a)+opWith o p =+  ListZipperOp (\z ->+    let go z' =+          let x = z' ^. focus+          in  case p x of+                Nothing ->+                  go =<< o &^. z'+                Just w ->+                  Just (w, x)+    in  go z+  )++moveLeftWith ::+  (a -> Maybe b)+  -> ListZipperOp a (b, a)+moveLeftWith =+  opWith moveLeft++moveRightWith ::+  (a -> Maybe b)+  -> ListZipperOp a (b, a)+moveRightWith =+  opWith moveRight++moveLeftRightWith ::+  (a -> Maybe b)+  -> ListZipperOp a (b, a)+moveLeftRightWith p =+  moveLeftWith p <!> moveRightWith p++moveRightLeftWith ::+  (a -> Maybe b)+  -> ListZipperOp a (b, a)+moveRightLeftWith p =+  moveRightWith p <!> moveLeftWith p+ opWhileJust ::-  ListZipperOp a+  ListZipperOp' a   -> ListZipper a   -> ListZipper a opWhileJust o z =@@ -307,50 +573,12 @@     Just z' ->       opWhileJust o z' -moveStart ::-  ListZipper a-  -> ListZipper a-moveStart =-  opWhileJust moveLeft--moveEnd ::-  ListZipper a-  -> ListZipper a-moveEnd =-  opWhileJust moveRight--atStart ::-  HasListZipper z a =>-  z-  -> Bool-atStart z =-  null (z ^. lefts)--atEnd ::-  HasListZipper z a =>-  z-  -> Bool-atEnd z =-  null (z ^. rights)--moveLeftLoop ::-  ListZipper a-  -> ListZipper a-moveLeftLoop z =-  fromMaybe (moveEnd z) (moveLeft &^. z)--moveRightLoop ::-  ListZipper a-  -> ListZipper a-moveRightLoop z =-  fromMaybe (moveStart z) (moveRight &^. z)- deleteStepLeft ::-  ListZipperOp a+  ListZipperOp' a deleteStepLeft =   ListZipperOp (\z ->-    let l = z ^. lefts-        r = z ^. rights+    let l = z ^. leftz+        r = z ^. rightz     in  case l of           [] ->             Nothing@@ -359,11 +587,11 @@   )  deleteStepRight ::-  ListZipperOp a+  ListZipperOp' a deleteStepRight =   ListZipperOp (\z ->-    let l = z ^. lefts-        r = z ^. rights+    let l = z ^. leftz+        r = z ^. rightz     in  case r of           [] ->             Nothing@@ -384,140 +612,6 @@   -> ListZipper a insertMoveRight a (ListZipper l x r) =   ListZipper l x (a:r)--class AsListZipper z a | z -> a where-  _ListZipper ::-    Prism' z (ListZipper a)-  -instance AsListZipper (ListZipper a) a where-  _ListZipper =-    id--class HasListZipper z a | z -> a where-  listZipper ::-    Lens' z (ListZipper a)-  focus ::-    Lens' z a-  {-# INLINE focus #-}-  lefts ::-    Lens' z [a]-  {-# INLINE lefts #-}-  rights ::-    Lens' z [a]-  {-# INLINE rights #-}-  lefts =-    listZipper . lefts-  focus =-    listZipper . focus-  rights =-    listZipper . rights--instance HasListZipper (ListZipper a) a where-  {-# INLINE focus #-}-  {-# INLINE lefts #-}-  {-# INLINE rights #-}-  listZipper =-    id-  lefts f (ListZipper l x r) =-    fmap (\l' -> ListZipper l' x r) (f l)-  focus f (ListZipper l x r) =-    fmap (\x' -> ListZipper l x' r) (f x)-  rights f (ListZipper l x r) =-    fmap (\r' -> ListZipper l x r') (f r)--lefts' ::-  HasListZipper z a =>-  Traversal' z a-lefts' =-  lefts . traverse--rights' ::-  HasListZipper z a =>-  Traversal' z a-rights' =-  rights . traverse--leftsrights ::-  Traversal' (ListZipper a) a-leftsrights f (ListZipper l x r) =-  (\l' r' -> ListZipper l' x r') <$> traverse f l <*> traverse f r--rightslefts ::-  Traversal' (ListZipper a) a-rightslefts f (ListZipper l x r) =-  (\r' l' -> ListZipper l' x r') <$> traverse f r <*> traverse f l--zipper ::-  [a]-  -> Maybe (ListZipper a)-zipper [] =-  Nothing-zipper (h:t) =-  Just (ListZipper [] h t)--zipper0L ::-  a-  -> [a]-  -> ListZipper a-zipper0L =-  ListZipper []--zipper0L' ::-  NonEmpty a-  -> ListZipper a-zipper0L' (h :| t) =-  zipper0L h t--zipper0R ::-  [a]-  -> a-  -> ListZipper a-zipper0R l x =-  ListZipper l x []--zipper0R' ::-  NonEmpty a-  -> ListZipper a-zipper0R' (h :| []) =-  ListZipper [] h []-zipper0R' (h :| i : t) =-  let ListZipper l x r = zipper0R' (i :| t)-  in  ListZipper (h:l) x r--list ::-  ListZipper a-  -> [a]-list (ListZipper l x r) =-  reverse l <> (x : r)--zipperIndices ::-  ListZipper a-  -> ListZipper (Int, a)-zipperIndices (ListZipper l x r) =-  let zipl ::-        [a]-        -> [b]-        -> ([a], [(a, b)])-      zipl y [] =-        (y, [])-      zipl [] (_:_) =-        ([], [])-      zipl (a:b) (c:d) =-        fmap ((a, c) :) (zipl b d)-      rl =-        reverse l-      (z, l') =-        zipl [0..] rl-      ln =-        case z of-          n:_ ->-            n-          [] ->-            0-  in  ListZipper-        (reverse l')-        (ln, x)-        (zip [ln + 1..] r)  deriveEq1 ''ListZipper deriveShow1 ''ListZipper