packages feed

list-zipper (empty) → 0.0.1

raw patch · 6 files changed

+636/−0 lines, 6 filesdep +QuickCheckdep +basedep +checkerssetup-changed

Dependencies added: QuickCheck, base, checkers, comonad, deriving-compat, lens, list-zipper, semigroupoids, semigroups, tasty, tasty-hunit, tasty-quickcheck

Files

+ LICENCE view
@@ -0,0 +1,31 @@+Copyright 2018 Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of QFPL nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.1++* Initial release
+ list-zipper.cabal view
@@ -0,0 +1,73 @@+name:               list-zipper+version:            0.0.1+license:            BSD3+license-file:       LICENCE+author:             Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer:         Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright:          Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+synopsis:           A list zipper+category:           Data+description:       +  <<http://i.imgur.com/uZnp9ke.png>>+  .+  A list zipper.+homepage:           https://github.com/qfpl/list-zipper+bug-reports:        https://github.com/qfpl/list-zipper/issues+cabal-version:      >= 1.10+build-type:         Simple+extra-source-files: changelog.md++source-repository   head+  type:             git+  location:         git@github.com:qfpl/list-zipper.git++library+  default-language:+                    Haskell2010++  build-depends:+                    base >= 4.8 && < 5+                    , deriving-compat >= 0.5 && < 0.6+                    , semigroups >= 0.9 && < 0.19+                    , semigroupoids >= 5.2 && < 6+                    , lens >= 4 && < 5+                    , comonad >= 5.0 && < 6.0+                    +  ghc-options:+                    -Wall++  default-extensions:+  +                    NoImplicitPrelude++  hs-source-dirs:+                    src++  exposed-modules:+                    Data.ListZipper++test-suite          tests++  build-depends:      QuickCheck >=2.9.2 && <2.13+                    , base >=4.8 && < 5+                    , checkers >=0.4.6 && <0.5+                    , list-zipper+                    , lens >=4 && <4.18+                    , tasty >=0.11 && <1.2+                    , tasty-hunit >=0.9 && <0.11+                    , tasty-quickcheck >=0.8.4 && <0.11++  type:             +                    exitcode-stdio-1.0++  main-is:          +                    Tests.hs++  hs-source-dirs:   +                    test++  default-language: +                    Haskell2010++  ghc-options:       +                    -Wall
+ src/Data/ListZipper.hs view
@@ -0,0 +1,523 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeFamilies #-}++module Data.ListZipper(+  ListZipper(..)+, ListZipperOp(..)+, pureListZipperOp+, unpureListZipperOp+, constListZipperOp+, idListZipperOp+, (<||>)+, (&^.)+, moveLeft+, moveRight+, opUntil+, moveLeftUntil+, moveRightUntil+, moveLeftRightUntil+, moveRightLeftUntil+, 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.Category((.), id)+import Control.Comonad(Comonad(duplicate, extract))+import Control.Lens hiding ((<.>))+import Control.Monad((>=>), (=<<))+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.Apply(Apply((<.>)))+import Data.Functor.Extend+import Data.Int(Int)+import Data.List(unfoldr, zipWith, repeat, reverse, null, zip)+import Data.List.NonEmpty(NonEmpty((:|)))+import Data.Maybe(Maybe(Nothing, Just), fromMaybe)+import Data.Monoid(Monoid(mappend, mempty))+import Data.Ord(Ord((<)))+import Data.Semigroup(Semigroup((<>)))+import Data.Semigroup.Foldable(Foldable1(foldMap1))+import Prelude(Show, (+))+import Text.Show.Deriving(deriveShow1)++data ListZipper a =+  ListZipper +    [a]+    a+    [a]+  deriving (Eq, Ord, Show)++instance Functor ListZipper where+  fmap f (ListZipper l x r) =+    ListZipper (fmap f l) (f x) (fmap f r)++instance Apply ListZipper where+  ListZipper l1 x1 r1 <.> ListZipper l2 x2 r2 =+    ListZipper (zipWith id l1 l2) (x1 x2) (zipWith id r1 r2)++instance Applicative ListZipper where+  pure a =+    ListZipper (repeat a) a (repeat a)+  (<*>) =+    (<.>)++instance Foldable ListZipper where+  foldMap f (ListZipper l x r) =+    foldMap f l `mappend` f x `mappend` foldMap f r++instance Foldable1 ListZipper where+  foldMap1 f (ListZipper [] x []) =+    f x+  foldMap1 f (ListZipper [] x (rh:rt)) =+    f x <> foldMap1 f (rh :| rt)+  foldMap1 f (ListZipper (lh:lt) x []) =+    foldMap1 f (lh :| lt) <> f x+  foldMap1 f (ListZipper (lh:lt) x (rh:rt)) =+    foldMap1 f (lh :| lt) <> f x <> foldMap1 f (rh :| rt)++instance Traversable ListZipper where+  traverse f (ListZipper l x r) =+    ListZipper <$> traverse f l <*> f x <*> traverse f r++instance Traversable1 ListZipper where+  traverse1 f (ListZipper [] x []) =+    (\x' -> ListZipper [] x' []) <$> f x+  traverse1 f (ListZipper (lh:lt) x []) =+    (\l' x' -> ListZipper (toList l') x' []) <$> traverse1 f (lh :| lt) <.> f x+  traverse1 f (ListZipper [] x (rh:rt)) =+    (\x' r' -> ListZipper [] x' (toList r')) <$> f x <.> traverse1 f (rh :| rt)+  traverse1 f (ListZipper (lh:lt) x (rh:rt)) =+    (\l' x' r' -> ListZipper (toList l') x' (toList r')) <$> traverse1 f (lh :| lt) <.> f x <.> traverse1 f (rh :| rt)++instance Semigroup a => Semigroup (ListZipper a) where+  ListZipper l1 x1 r1 <> ListZipper l2 x2 r2 =+    ListZipper (zipWith (<>) l1 l2) (x1 <> x2) (zipWith (<>) r1 r2)++instance Each (ListZipper a) (ListZipper a) a a where+  each =+    traverse++instance Reversing (ListZipper a) where+  reversing (ListZipper l x r) =+    ListZipper (reverse l) x (reverse r)++type instance IxValue (ListZipper a) = a+type instance Index (ListZipper a) = Int+instance Ixed (ListZipper a) where+  ix i f z =+    if i < 0+      then+        pure z+      else+        let ListZipper l x r =+              zipperIndices z+            applyn (n, a) =+              if i == n+                then+                  f a+                else+                  pure a+        in  ListZipper <$> traverse applyn l <*> applyn x <*> traverse applyn r++instance Extend ListZipper where+  duplicated z =+    let dup x =+          (x, x)+        unf m =+          unfoldr (fmap dup . (m ^. _Wrapped)) z+    in  ListZipper (unf moveLeft) z (unf moveRight)++instance Comonad ListZipper where+  duplicate =+    duplicated+  extract (ListZipper _ x _) =+    x++newtype ListZipperOp a =+  ListZipperOp+    (ListZipper a -> Maybe (ListZipper a))++instance ListZipperOp x ~ y =>+  Rewrapped (ListZipperOp w) y++instance Wrapped (ListZipperOp x) where+  type Unwrapped (ListZipperOp x) =+    ListZipper x+    -> Maybe (ListZipper x)+  _Wrapped' =+    iso+      (\(ListZipperOp x) -> x)+      ListZipperOp++instance Semigroup (ListZipperOp a) where+  ListZipperOp x <> ListZipperOp y =+    ListZipperOp (x >=> y)++instance Monoid (ListZipperOp a) where+  mappend =+    (<>)+  mempty =+    ListZipperOp (pure Nothing)++pureListZipperOp ::+  (ListZipper a -> ListZipper a)+  -> ListZipperOp a+pureListZipperOp k =+  ListZipperOp (Just . k)++unpureListZipperOp ::+  ListZipperOp a+  -> ListZipper a+  -> ListZipper a+unpureListZipperOp (ListZipperOp x) =+  fromMaybe <*> x++constListZipperOp ::+  ListZipper a+  -> ListZipperOp a+constListZipperOp =+  pureListZipperOp . pure++idListZipperOp ::+  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)+(&^.) o z =+  z & o ^. _Wrapped++infixr 5 &^.++moveLeft ::+  ListZipperOp a+moveLeft =+  ListZipperOp (\z ->+    case z of+      ListZipper [] _ _ ->+        Nothing+      ListZipper (h:t) x r ->+        Just (ListZipper t h (x:r))+  )++moveRight ::+  ListZipperOp a+moveRight =+  ListZipperOp (\z ->+    case z of+      ListZipper _ _ [] ->+        Nothing+      ListZipper l x (h:t) ->+        Just (ListZipper (x:l) h t)+  )++opUntil ::+  ListZipperOp a+  -> (a -> Bool)+  -> ListZipperOp a+opUntil o p =+  ListZipperOp (\z ->+    let go z' =+          let x = z' ^. focus+          in  if p x+                then+                  Just z'+                else+                  go =<< o &^. z'+    in  go z+  )++moveLeftUntil ::+  (a -> Bool)+  -> ListZipperOp a+moveLeftUntil =+  opUntil moveLeft++moveRightUntil ::+  (a -> Bool)+  -> ListZipperOp a+moveRightUntil =+  opUntil moveRight++moveLeftRightUntil ::+  (a -> Bool)+  -> ListZipperOp a+moveLeftRightUntil p =+  moveLeftUntil p <||> moveRightUntil p++moveRightLeftUntil ::+  (a -> Bool)+  -> ListZipperOp a+moveRightLeftUntil p =+  moveRightUntil p <||> moveLeftUntil p++opWhileJust ::+  ListZipperOp a+  -> ListZipper a+  -> ListZipper a+opWhileJust o z =+  case o &^. z of+    Nothing ->+      z+    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+deleteStepLeft =+  ListZipperOp (\z ->+    let l = z ^. lefts+        r = z ^. rights+    in  case l of+          [] ->+            Nothing+          h:t ->+            Just (ListZipper t h r)+  )++deleteStepRight ::+  ListZipperOp a+deleteStepRight =+  ListZipperOp (\z ->+    let l = z ^. lefts+        r = z ^. rights+    in  case r of+          [] ->+            Nothing+          h:t ->+            Just (ListZipper l h t)+  )++insertMoveLeft ::+  a+  -> ListZipper a+  -> ListZipper a+insertMoveLeft a (ListZipper l x r) =+  ListZipper (a:l) x r++insertMoveRight ::+  a+  -> ListZipper a+  -> 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
+ test/Tests.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = pure ()