mono-traversable 1.0.1 → 1.0.21.0
raw patch · 15 files changed
Files
- ChangeLog.md +137/−1
- README.md +2/−2
- bench/InitTails.hs +89/−0
- bench/Sorting.hs +43/−0
- bench/main.hs +17/−0
- bench/sorting.hs +0/−32
- mono-traversable.cabal +93/−69
- src/Data/Containers.hs +38/−27
- src/Data/MonoTraversable.hs +385/−111
- src/Data/MonoTraversable/Unprefixed.hs +1/−15
- src/Data/NonNull.hs +31/−13
- src/Data/Sequences.hs +252/−29
- test/Main.hs +609/−0
- test/Spec.hs +0/−482
- test/main.hs +0/−1
ChangeLog.md view
@@ -1,3 +1,139 @@+# ChangeLog for mono-traversable++## 1.0.21.0++* Support for vector 0.13.2.0, adding instances for [`Data.Vector.Strict`](https://hackage.haskell.org/package/vector-0.13.2.0/docs/Data-Vector-Strict.html) data structure.+ [#244](https://github.com/snoyberg/mono-traversable/issues/244)++## 1.0.20.0++* Added instances for [`Reverse`](https://hackage.haskell.org/package/transformers-0.6.1.1/docs/Data-Functor-Reverse.html#t:Reverse) data structure.++## 1.0.19.1++* Removed 'highly experimental' warning haddock comment from Data.Containers.++## 1.0.19.0++* Added `filterWithKey` to `IsMap`.+ [#232](https://github.com/snoyberg/mono-traversable/pull/232)++## 1.0.18.0++* Added MonoPointed instance for text Builder+ [#225](https://github.com/snoyberg/mono-traversable/pull/225)++## 1.0.17.0++* Added `inits`, `tails`, `initTails` to class `IsSequence` with tests and benchmarks for `initTails`.+* Improved ghc benchmark flags.+* Removed extraneous constraint `IsSequence` from `initMay`.++## 1.0.16.0++* Added MonoPointed instance for bytestring Builder+ [#219](https://github.com/snoyberg/mono-traversable/pull/219#pullrequestreview-1879553961)++## 1.0.15.3++* Compile with GHC 9.2 (`Option` removed from `base-4.16`)+ [#199](https://github.com/snoyberg/mono-traversable/issues/199)++## 1.0.15.2++* Support transformers 0.6.0.0 [#196](https://github.com/snoyberg/mono-traversable/issues/196)+* Compile with GHC 9 [#193](https://github.com/snoyberg/mono-traversable/pull/193)++## 1.0.15.1++* Remove whitespace after `@` in as-patterns for GHC HEAD [#186](https://github.com/snoyberg/mono-traversable/pull/186)++## 1.0.15.0++* Added `toNonEmpty` to `Data.NonNull`+ [#185](https://github.com/snoyberg/mono-traversable/pull/185)++## 1.0.14.0+* Added `WrappedMono` to `Data.MonoTraversable`+ [#182](https://github.com/snoyberg/mono-traversable/pull/182)++## 1.0.13.0+* Added `WrappedPoly` to `Data.MonoTraversable`+ [#180](https://github.com/snoyberg/mono-traversable/pull/180)++## 1.0.12.0+* Added `filterSet` to `Data.Containers`+* Use container specific implementations for `filterSet` and `filterMap`+ [#178](https://github.com/snoyberg/mono-traversable/pull/178)++## 1.0.11.0++* Adding monomorphic instances for GHC.Generics and Data.Proxy types+ [#175](https://github.com/snoyberg/mono-traversable/issues/175)++## 1.0.10.0++* Make index work on negative indices+ [#172](https://github.com/snoyberg/mono-traversable/issues/172)+ [#114](https://github.com/snoyberg/mono-traversable/issues/114)++## 1.0.9.0++* Added `filterMap` to `Data.Containers`+ [#167](https://github.com/snoyberg/mono-traversable/pull/167)++## 1.0.8.1++* Compat with gauge 0.1 and 0.2++## 1.0.8.0++* Switch to gauge+* Relax constraint on `singleton` to `MonoPointed`+ [#156](https://github.com/snoyberg/mono-traversable/issues/156)++## 1.0.7.0++* Add `dropPrefix` and `dropSuffix` to `Data.Sequences` [#139](https://github.com/snoyberg/mono-traversable/issues/139)+* Change `sort` implementation [#153](https://github.com/snoyberg/mono-traversable/issues/153)++## 1.0.6.0++* Add `mapNonNull` function to `Data.NonNull` [#150](https://github.com/snoyberg/mono-traversable/issues/150)++## 1.0.5.0++* Move `oelem` and `onotElem` into the `MonoFoldable` class [#133](https://github.com/snoyberg/mono-traversable/issues/133)+ * Change `instance MonoFoldable (Set e)` to `instance Ord e => MonoFoldable (Set e)`++## 1.0.4.0++* Add `dropEnd` function to the `IsSequence` class, and a specialized implementation for `Text`++## 1.0.3.0++* Add `ensurePrefix` and `ensureSuffix` functions [#141](https://github.com/snoyberg/mono-traversable/pull/141)++## 1.0.2.1++* Fix test suite for foldl 1.3++## 1.0.2++* `IsSequence` class: add `lengthIndex` [#127](https://github.com/snoyberg/mono-traversable/pull/127)++## 1.0.1.3++* Make 'olength' for Set and Map O(1) [#125](https://github.com/snoyberg/mono-traversable/pull/125)++## 1.0.1.2++* Support for GHC 8.2++## 1.0.1.1++* Fix typo in rewrite rule+ ## 1.0.1 * Add `replaceElem` and `replaceSeq` [#107](https://github.com/snoyberg/mono-traversable/pull/107)@@ -71,7 +207,7 @@ `EqSequence` now inherits from `MonoFoldableEq`. For most users that do not define instances this should not be a breaking change.-However, any instance of `EqSequence` now needs to definie `MonoFoldableEq`.+However, any instance of `EqSequence` now needs to define `MonoFoldableEq`. ## 0.7.0
README.md view
@@ -13,7 +13,7 @@ In addition to this package, the [mono-traversable-instances](https://www.stackage.org/package/mono-traversable-instances)-pacakge provides a number of orphan instances.+package provides a number of orphan instances. Using Typeclasses@@ -155,7 +155,7 @@ * IsMap: unifies operations across different `Map`s * MonoZip: zip operations on MonoFunctors. -Note that because `Set` and `Map` are not a Functor (and therefore not MonoFoldable), one must use `mapFromList`, `mapToList`, `setFromList`, and `setToList`.+Note that because `Set` is not a Functor (and therefore neither a MonoFunctor nor MonoTraversable), one must use `setFromList` and `setToList` to `omap` or `otraverse` over the elements of a `Set`. ### Sequences
+ bench/InitTails.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE TypeFamilies #-}+module InitTails (initTailsBenchmarks) where++#if MIN_VERSION_gauge(0,2,0)+import Gauge+#else+import Gauge.Main+#endif++import Data.Sequences as Ss+import Data.MonoTraversable+import Type.Reflection (Typeable, typeRep)+import Control.DeepSeq+import Data.Foldable (foldl')+import Data.Functor ((<&>))++import Data.ByteString (StrictByteString)+import Data.ByteString.Lazy (LazyByteString)+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import Data.Sequence (Seq)+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU+import qualified Data.Vector.Storable as VS++initTailsBenchmarks :: Benchmark+initTailsBenchmarks = bgroup "InitTails"+ [ bmg @[Char]+ , bmg @StrictByteString+ , bmg @LazyByteString+ , bmg @TS.Text+ , bmg @TL.Text+ , bmg @(Seq Char)+ , bmg @(V.Vector Char)+ , bmg @(VU.Vector Char)+ , bmg @(VS.Vector Char)+ ]++bmg :: forall seq.+ ( TestLabel seq+ , NFData seq+ , IsSequence seq+ , Num (Index seq)+ , Enum (Element seq)+ ) => Benchmark+bmg = bgroup (testLabel @seq) $ bm <$> labelledLengths+ where+ bm :: (String,[Int]) -> Benchmark+ bm (label,lengths) = bgroup label $+ [ ("weak", weakConsume)+ , ("deep", deepConsume)+ ] <&> \(wdLabel,consume) -> bench wdLabel+ $ nf (map $ consume . initTails @seq)+ $ (`Ss.replicate` (toEnum 65)) . fromIntegral <$> lengths+ labelledLengths =+ [ ("tiny", [0,1,2,5,10])+ , ("small", [100,150,200,300])+ , ("medium", [1000,1500,2000,2500])+ , ("large", [10000,20000,50000])+ ]++class Typeable a => TestLabel a where+ testLabel :: String+ testLabel = show $ typeRep @a+instance TestLabel [Char]+instance TestLabel StrictByteString where testLabel = "StrictByteString"+instance TestLabel LazyByteString where testLabel = "LazyByteString"+instance TestLabel TS.Text where testLabel = "StrictText"+instance TestLabel TL.Text where testLabel = "LazyText"+instance TestLabel (Seq Char) where testLabel = "Seq"+instance TestLabel (V.Vector Char) where testLabel = "Vector"+instance TestLabel (VU.Vector Char) where testLabel = "UnboxedVector"+instance TestLabel (VS.Vector Char) where testLabel = "StorableVector"+++-- *Consume used to keep memory usage lower+deepConsume :: NFData seq => [(seq,seq)] -> ()+deepConsume = foldl' (\() (is,ts) -> deepseq is $ deepseq ts ()) ()++weakConsume :: [(seq,seq)] -> ()+weakConsume = foldl' (\() (_,_) -> ()) ()+
+ bench/Sorting.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+module Sorting (sortingBenchmarks) where++#if MIN_VERSION_gauge(0,2,0)+import Gauge+#else+import Gauge.Main+#endif++import Data.Sequences+import Data.MonoTraversable+import qualified Data.List+import qualified System.Random.MWC as MWC+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import System.IO.Unsafe (unsafePerformIO)++sortingBenchmarks :: Benchmark+sortingBenchmarks+ = bgroup "Sorting"+ $ unsafePerformIO+ $ mapM mkGroup [10, 100, 1000, 10000]++asVector :: V.Vector a -> V.Vector a+asVector = id++asUVector :: U.Vector a -> U.Vector a+asUVector = id++mkGroup :: Int -> IO Benchmark+mkGroup size = do+ gen <- MWC.create+ inputV <- MWC.uniformVector gen size+ let inputL = otoList (inputV :: V.Vector Int)+ inputVU = fromList inputL :: U.Vector Int+ return $ bgroup (show size)+ [ bench "Data.List.sort" $ nf Data.List.sort inputL+ , bench "list sort" $ nf sort inputL+ , bench "list sort, via vector" $ nf (otoList . sort . asVector . fromList) inputL+ , bench "list sort, via uvector" $ nf (otoList . sort . asUVector . fromList) inputL+ , bench "vector sort" $ nf sort inputV+ , bench "uvector sort" $ nf sort inputVU+ ]
+ bench/main.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE CPP #-}++#if MIN_VERSION_gauge(0,2,0)+import Gauge+#else+import Gauge.Main+#endif++import Sorting (sortingBenchmarks)+import InitTails (initTailsBenchmarks)+++main :: IO ()+main = defaultMain+ [ sortingBenchmarks+ , initTailsBenchmarks+ ]
− bench/sorting.hs
@@ -1,32 +0,0 @@-import Criterion.Main-import Data.Sequences-import Data.MonoTraversable-import qualified Data.List-import qualified System.Random.MWC as MWC-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U--asVector :: V.Vector a -> V.Vector a-asVector = id--asUVector :: U.Vector a -> U.Vector a-asUVector = id--main :: IO ()-main = do- mapM mkGroup [10, 100, 1000, 10000] >>= defaultMain--mkGroup :: Int -> IO Benchmark-mkGroup size = do- gen <- MWC.create- inputV <- MWC.uniformVector gen size- let inputL = otoList (inputV :: V.Vector Int)- inputVU = fromList inputL :: U.Vector Int- return $ bgroup (show size)- [ bench "Data.List.sort" $ nf Data.List.sort inputL- , bench "list sort" $ nf sort inputL- , bench "list sort, via vector" $ nf (otoList . sort . asVector . fromList) inputL- , bench "list sort, via uvector" $ nf (otoList . sort . asUVector . fromList) inputL- , bench "vector sort" $ nf sort inputV- , bench "uvector sort" $ nf sort inputVU- ]
mono-traversable.cabal view
@@ -1,75 +1,99 @@-name: mono-traversable-version: 1.0.1-synopsis: Type classes for mapping, folding, and traversing monomorphic containers-description: Monomorphic variants of the Functor, Foldable, and Traversable typeclasses. If you understand Haskell's basic typeclasses, you understand mono-traversable. In addition to what you are used to, it adds on an IsSequence typeclass and has code for marking data structures as non-empty.-homepage: https://github.com/snoyberg/mono-traversable-license: MIT-license-file: LICENSE-author: Michael Snoyman, John Wiegley, Greg Weber-maintainer: michael@snoyman.com-category: Data-build-type: Simple-extra-source-files: README.md- ChangeLog.md-cabal-version: >=1.10+cabal-version: 1.12 -library- ghc-options: -Wall- exposed-modules: Data.MonoTraversable- Data.MonoTraversable.Unprefixed- Data.Containers- Data.Sequences- Data.NonNull- build-depends: base >= 4.5 && < 5- , containers >= 0.4- , unordered-containers >=0.2- , hashable- , bytestring >= 0.9- , text >=0.11- , transformers >=0.3- , vector >=0.10- , vector-algorithms >= 0.6- , split >= 0.2+-- This file has been generated from package.yaml by hpack version 0.37.0.+--+-- see: https://github.com/sol/hpack - if impl(ghc < 8.0)- build-depends: semigroups >= 0.10+name: mono-traversable+version: 1.0.21.0+synopsis: Type classes for mapping, folding, and traversing monomorphic containers+description: Please see the README at <https://www.stackage.org/package/mono-traversable>+category: Data+homepage: https://github.com/snoyberg/mono-traversable#readme+bug-reports: https://github.com/snoyberg/mono-traversable/issues+author: Michael Snoyman, John Wiegley, Greg Weber+maintainer: michael@snoyman.com+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md - hs-source-dirs: src- default-language: Haskell2010+source-repository head+ type: git+ location: https://github.com/snoyberg/mono-traversable -test-suite test- main-is: main.hs- type: exitcode-stdio-1.0- hs-source-dirs: test- other-modules: Spec- default-language: Haskell2010- ghc-options: -O0- build-depends: base- , mono-traversable- , bytestring- , text- , hspec- , HUnit- , transformers- , vector- , QuickCheck- , semigroups- , containers- , unordered-containers- , foldl+library+ exposed-modules:+ Data.Containers+ Data.MonoTraversable+ Data.MonoTraversable.Unprefixed+ Data.NonNull+ Data.Sequences+ other-modules:+ Paths_mono_traversable+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.13 && <5+ , bytestring >=0.9+ , containers >=0.5.8+ , hashable+ , split >=0.2+ , text >=0.11+ , transformers >=0.3+ , unordered-containers >=0.2+ , vector >=0.10+ , vector-algorithms >=0.6+ default-language: Haskell2010 -benchmark sorting- type: exitcode-stdio-1.0- hs-source-dirs: bench- build-depends: base- , criterion- , mono-traversable- , vector- , mwc-random- main-is: sorting.hs- ghc-options: -Wall -O2- default-language: Haskell2010+test-suite test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_mono_traversable+ hs-source-dirs:+ test+ ghc-options: -O0+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ HUnit+ , QuickCheck+ , base+ , bytestring+ , containers+ , foldl+ , hspec+ , mono-traversable+ , text+ , transformers+ , unordered-containers+ , vector+ default-language: Haskell2010 -source-repository head- type: git- location: git://github.com/snoyberg/mono-traversable.git+benchmark all+ type: exitcode-stdio-1.0+ main-is: main.hs+ other-modules:+ InitTails+ Sorting+ Paths_mono_traversable+ hs-source-dirs:+ bench+ ghc-options: -Wall -O2 -with-rtsopts=-A32m+ build-depends:+ base+ , bytestring+ , containers+ , deepseq+ , gauge+ , mono-traversable+ , mwc-random+ , text+ , vector+ default-language: Haskell2010+ if impl(ghc >= 8.6)+ ghc-options: -fproc-alignment=64
src/Data/Containers.hs view
@@ -4,24 +4,18 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}--- | Warning: This module should be considered highly experimental.+{-# LANGUAGE TypeOperators #-} module Data.Containers where import Prelude hiding (lookup) import Data.Maybe (fromMaybe)-#if MIN_VERSION_containers(0, 5, 0) import qualified Data.Map.Strict as Map import qualified Data.IntMap.Strict as IntMap-#else-import qualified Data.Map as Map-import qualified Data.IntMap as IntMap-#endif import qualified Data.HashMap.Strict as HashMap import Data.Hashable (Hashable) import qualified Data.Set as Set import qualified Data.HashSet as HashSet import Data.Monoid (Monoid (..))-import Data.Semigroup (Semigroup) import Data.MonoTraversable (MonoFunctor(..), MonoFoldable, MonoTraversable, Element, GrowingAppend, ofoldl', otoList) import Data.Function (on) import qualified Data.List as List@@ -67,9 +61,7 @@ -- | Get a list of all of the keys in the container. keys :: set -> [ContainerKey set] -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.Map.Strict".-#endif instance Ord k => SetContainer (Map.Map k v) where type ContainerKey (Map.Map k v) = k member = Map.member@@ -87,9 +79,7 @@ keys = Map.keys {-# INLINE keys #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict".-#endif instance (Eq key, Hashable key) => SetContainer (HashMap.HashMap key value) where type ContainerKey (HashMap.HashMap key value) = key member = HashMap.member@@ -107,9 +97,7 @@ keys = HashMap.keys {-# INLINE keys #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict".-#endif instance SetContainer (IntMap.IntMap value) where type ContainerKey (IntMap.IntMap value) = Int member = IntMap.member@@ -213,9 +201,7 @@ intersectionWithMap :: (value1 -> value2 -> value3) -> map value1 -> map value2 -> map value3 -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.Map.Strict".-#endif instance Ord key => PolyMap (Map.Map key) where differenceMap = Map.difference {-# INLINE differenceMap #-}@@ -225,9 +211,7 @@ intersectionWithMap = Map.intersectionWith {-# INLINE intersectionWithMap #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict".-#endif instance (Eq key, Hashable key) => PolyMap (HashMap.HashMap key) where differenceMap = HashMap.difference {-# INLINE differenceMap #-}@@ -237,9 +221,7 @@ intersectionWithMap = HashMap.intersectionWith {-# INLINE intersectionWithMap #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict".-#endif instance PolyMap IntMap.IntMap where differenceMap = IntMap.difference {-# INLINE differenceMap #-}@@ -562,9 +544,20 @@ where go (k, v) = [(f k, v)] -#if MIN_VERSION_containers(0, 5, 0)+ -- | Filter values in a map.+ --+ -- @since 1.0.9.0+ filterMap :: (MapValue map -> Bool) -> map -> map+ filterMap = filterWithKey . const++ -- | Equivalent to 'filterMap', but the function accepts the key,+ -- as well as the value.+ --+ -- @since 1.0.19.0+ filterWithKey :: (ContainerKey map -> MapValue map -> Bool) -> map -> map+ filterWithKey p = mapFromList . filter (uncurry p) . mapToList+ -- | This instance uses the functions from "Data.Map.Strict".-#endif instance Ord key => IsMap (Map.Map key value) where type MapValue (Map.Map key value) = value lookup = Map.lookup@@ -610,10 +603,12 @@ {-# INLINE mapWithKey #-} omapKeysWith = Map.mapKeysWith {-# INLINE omapKeysWith #-}+ filterMap = Map.filter+ {-# INLINE filterMap #-}+ filterWithKey = Map.filterWithKey+ {-# INLINE filterWithKey #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.HashMap.Strict".-#endif instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where type MapValue (HashMap.HashMap key value) = value lookup = HashMap.lookup@@ -647,10 +642,12 @@ --unionsWith = HashMap.unionsWith --mapWithKey = HashMap.mapWithKey --mapKeysWith = HashMap.mapKeysWith+ filterMap = HashMap.filter+ {-# INLINE filterMap #-}+ filterWithKey = HashMap.filterWithKey+ {-# INLINE filterWithKey #-} -#if MIN_VERSION_containers(0, 5, 0) -- | This instance uses the functions from "Data.IntMap.Strict".-#endif instance IsMap (IntMap.IntMap value) where type MapValue (IntMap.IntMap value) = value lookup = IntMap.lookup@@ -693,10 +690,12 @@ {-# INLINE unionsWith #-} mapWithKey = IntMap.mapWithKey {-# INLINE mapWithKey #-}-#if MIN_VERSION_containers(0, 5, 0) omapKeysWith = IntMap.mapKeysWith {-# INLINE omapKeysWith #-}-#endif+ filterMap = IntMap.filter+ {-# INLINE filterMap #-}+ filterWithKey = IntMap.filterWithKey+ {-# INLINE filterWithKey #-} instance Eq key => IsMap [(key, value)] where type MapValue [(key, value)] = value@@ -730,6 +729,12 @@ -- | Convert a set to a list. setToList :: set -> [Element set] + -- | Filter values in a set.+ --+ -- @since 1.0.12.0+ filterSet :: (Element set -> Bool) -> set -> set+ filterSet p = setFromList . filter p . setToList+ instance Ord element => IsSet (Set.Set element) where insertSet = Set.insert {-# INLINE insertSet #-}@@ -741,6 +746,8 @@ {-# INLINE setFromList #-} setToList = Set.toList {-# INLINE setToList #-}+ filterSet = Set.filter+ {-# INLINE filterSet #-} instance (Eq element, Hashable element) => IsSet (HashSet.HashSet element) where insertSet = HashSet.insert@@ -753,6 +760,8 @@ {-# INLINE setFromList #-} setToList = HashSet.toList {-# INLINE setToList #-}+ filterSet = HashSet.filter+ {-# INLINE filterSet #-} instance IsSet IntSet.IntSet where insertSet = IntSet.insert@@ -765,6 +774,8 @@ {-# INLINE setFromList #-} setToList = IntSet.toList {-# INLINE setToList #-}+ filterSet = IntSet.filter+ {-# INLINE filterSet #-} -- | Zip operations on 'MonoFunctor's.
src/Data/MonoTraversable.hs view
@@ -1,10 +1,14 @@ {-# LANGUAGE ConstrainedClassMethods #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Type classes mirroring standard typeclasses, but working with monomorphic containers. -- -- The motivation is that some commonly used data types (i.e., 'ByteString' and@@ -26,23 +30,23 @@ import Control.Applicative import Control.Category-#if MIN_VERSION_base(4,8,0) import Control.Monad (Monad (..))-#else-import Control.Monad (Monad (..), liftM)-#endif import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Builder as B import qualified Data.Foldable as F import Data.Functor import Data.Maybe (fromMaybe)-import Data.Monoid (Monoid (..), Any (..), All (..))+import Data.Monoid (Dual(..), Monoid (..), Any (..), All (..))+import Data.Proxy import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB import Data.Traversable import Data.Word (Word8) import Data.Int (Int, Int64) import GHC.Exts (build)+import GHC.Generics ((:.:), (:*:), (:+:)(..), K1(..), M1(..), Par1(..), Rec1(..), U1(..), V1) import Prelude (Bool (..), const, Char, flip, IO, Maybe (..), Either (..), (+), Integral, Ordering (..), compare, fromIntegral, Num, (>=), (==), seq, otherwise, Eq, Ord, (-), (*))@@ -52,6 +56,7 @@ import Foreign.Ptr (plusPtr) import Foreign.ForeignPtr (touchForeignPtr) import Foreign.Storable (peek)+import Control.Applicative.Backwards (Backwards (..)) import Control.Arrow (Arrow) import Data.Tree (Tree (..)) import Data.Sequence (Seq, ViewL (..), ViewR (..))@@ -61,11 +66,15 @@ import qualified Data.List as List import Data.List.NonEmpty (NonEmpty) import Data.Functor.Identity (Identity)+import Data.Functor.Reverse (Reverse (..)) import Data.Map (Map)+import qualified Data.Map.Strict as Map import Data.HashMap.Strict (HashMap) import Data.Vector (Vector) import Control.Monad.Trans.Maybe (MaybeT (..))+#if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List (ListT)+#endif import Control.Monad.Trans.Writer (WriterT) import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT) import Control.Monad.Trans.State (StateT(..))@@ -84,8 +93,20 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VSC+#else+{-# DependencyDeprecation "Support for vector < 0.13.2 will be removed when GHC 9.12 reaches Stackage nightly. Please upgrade to vector >= 0.13.2." #-}+#endif import qualified Data.IntSet as IntSet-import Data.Semigroup (Semigroup, Option (..), Arg)+import Data.Semigroup+ ( Semigroup+-- Option has been removed in base-4.16 (GHC 9.2)+#if !MIN_VERSION_base(4,16,0)+ , Option (..)+#endif+ , Arg+ ) import qualified Data.ByteString.Unsafe as SU import Control.Monad.Trans.Identity (IdentityT) @@ -94,8 +115,12 @@ type family Element mono type instance Element S.ByteString = Word8 type instance Element L.ByteString = Word8+-- | @since 1.0.16.0+type instance Element B.Builder = Word8 type instance Element T.Text = Char type instance Element TL.Text = Char+-- | @since 1.0.18.0+type instance Element TB.Builder = Char type instance Element [a] = a type instance Element (IO a) = a type instance Element (ZipList a) = a@@ -106,7 +131,9 @@ type instance Element (ViewR a) = a type instance Element (IntMap a) = a type instance Element IntSet = Int+#if !MIN_VERSION_base(4,16,0) type instance Element (Option a) = a+#endif type instance Element (NonEmpty a) = a type instance Element (Identity a) = a type instance Element (r -> a) = a@@ -121,7 +148,9 @@ type instance Element (Vector a) = a type instance Element (WrappedArrow a b c) = c type instance Element (MaybeT m a) = a+#if !MIN_VERSION_transformers(0,6,0) type instance Element (ListT m a) = a+#endif type instance Element (IdentityT m a) = a type instance Element (WriterT w m a) = a type instance Element (Strict.WriterT w m a) = a@@ -135,13 +164,29 @@ type instance Element (Product f g a) = a type instance Element (U.Vector a) = a type instance Element (VS.Vector a) = a+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+type instance Element (VSC.Vector a) = a+#endif type instance Element (Arg a b) = b+type instance Element ((f :.: g) a) = a+type instance Element ((f :*: g) a) = a+type instance Element ((f :+: g) a) = a+type instance Element (K1 i c a) = a+type instance Element (M1 i c f a) = a+type instance Element (Rec1 f a) = a+type instance Element (Par1 a) = a+type instance Element (U1 a) = a+type instance Element (V1 a) = a+type instance Element (Proxy a) = a+type instance Element (Reverse f a) = Element (f a) -- | Monomorphic containers that can be mapped over. class MonoFunctor mono where -- | Map over a monomorphic container omap :: (Element mono -> Element mono) -> mono -> mono- default omap :: (Functor f, Element (f a) ~ a, f a ~ mono) => (a -> a) -> f a -> f a+ default omap :: (Functor f, Element (f a) ~ a, f a ~ mono)+ => (Element mono -> Element mono) -> mono -> mono omap = fmap {-# INLINE omap #-} @@ -166,7 +211,9 @@ instance MonoFunctor (ViewL a) instance MonoFunctor (ViewR a) instance MonoFunctor (IntMap a)+#if !MIN_VERSION_base(4,16,0) instance MonoFunctor (Option a)+#endif instance MonoFunctor (NonEmpty a) instance MonoFunctor (Identity a) instance MonoFunctor (r -> a)@@ -180,7 +227,9 @@ instance MonoFunctor (Arg a b) instance Arrow a => MonoFunctor (WrappedArrow a b c) instance Functor m => MonoFunctor (MaybeT m a)+#if !MIN_VERSION_transformers(0,6,0) instance Functor m => MonoFunctor (ListT m a)+#endif instance Functor m => MonoFunctor (IdentityT m a) instance Functor m => MonoFunctor (WriterT w m a) instance Functor m => MonoFunctor (Strict.WriterT w m a)@@ -192,12 +241,39 @@ instance Functor m => MonoFunctor (ContT r m a) instance (Functor f, Functor g) => MonoFunctor (Compose f g a) instance (Functor f, Functor g) => MonoFunctor (Product f g a)+-- | @since 1.0.11.0+instance (Functor f, Functor g) => MonoFunctor ((f :.: g) a)+-- | @since 1.0.11.0+instance (Functor f, Functor g) => MonoFunctor ((f :*: g) a)+-- | @since 1.0.11.0+instance (Functor f, Functor g) => MonoFunctor ((f :+: g) a)+-- | @since 1.0.11.0+instance MonoFunctor (K1 i c a)+-- | @since 1.0.11.0+instance Functor f => MonoFunctor (M1 i c f a)+-- | @since 1.0.11.0+instance Functor f => MonoFunctor (Rec1 f a)+-- | @since 1.0.11.0+instance MonoFunctor (Par1 a)+-- | @since 1.0.11.0+instance MonoFunctor (U1 a)+-- | @since 1.0.11.0+instance MonoFunctor (V1 a)+-- | @since 1.0.11.0+instance MonoFunctor (Proxy a) instance U.Unbox a => MonoFunctor (U.Vector a) where omap = U.map {-# INLINE omap #-} instance VS.Storable a => MonoFunctor (VS.Vector a) where omap = VS.map {-# INLINE omap #-}+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance MonoFunctor (VSC.Vector a)+#endif+-- | @since 1.0.20.0+instance MonoFunctor (f a) => MonoFunctor (Reverse f a) where+ omap f (Reverse t) = Reverse (omap f t) -- | @'replaceElem' old new@ replaces all @old@ elements with @new@. --@@ -288,23 +364,13 @@ -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and ignore the results.-#if MIN_VERSION_base(4,8,0) omapM_ :: Applicative m => (Element mono -> m ()) -> mono -> m () omapM_ = otraverse_-#else- omapM_ :: Monad m => (Element mono -> m ()) -> mono -> m ()- omapM_ f = ofoldr ((>>) . f) (return ())-#endif {-# INLINE omapM_ #-} -- | 'oforM_' is 'omapM_' with its arguments flipped.-#if MIN_VERSION_base(4,8,0) oforM_ :: Applicative m => mono -> (Element mono -> m ()) -> m () oforM_ = flip omapM_-#else- oforM_ :: Monad m => mono -> (Element mono -> m ()) -> m ()- oforM_ = flip omapM_-#endif {-# INLINE oforM_ #-} -- | Monadic fold over the elements of a monomorphic container, associating to the left.@@ -322,17 +388,17 @@ -- /See 'Data.NonNull.ofoldMap1' from "Data.NonNull" for a total version of this function./ ofoldMap1Ex :: Semigroup m => (Element mono -> m) -> mono -> m ofoldMap1Ex f = fromMaybe (Prelude.error "Data.MonoTraversable.ofoldMap1Ex")- . getOption . ofoldMap (Option . Just . f)+ . ofoldMap (Just . f) -- | Right-associative fold of a monomorphic container with no base element. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. --- -- /See 'Data.NonNull.ofoldr1Ex' from "Data.NonNull" for a total version of this function./+ -- /See 'Data.NonNull.ofoldr1' from "Data.NonNull" for a total version of this function./ ofoldr1Ex :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldr1Ex :: (t a ~ mono, a ~ Element (t a), F.Foldable t)- => (a -> a -> a) -> mono -> a+ => (Element mono -> Element mono -> Element mono) -> mono -> Element mono ofoldr1Ex = F.foldr1 {-# INLINE ofoldr1Ex #-} @@ -342,10 +408,10 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. --- -- /See 'Data.NonNull.ofoldl1Ex'' from "Data.NonNull" for a total version of this function./+ -- /See 'Data.NonNull.ofoldl1'' from "Data.NonNull" for a total version of this function./ ofoldl1Ex' :: (Element mono -> Element mono -> Element mono) -> mono -> Element mono default ofoldl1Ex' :: (t a ~ mono, a ~ Element (t a), F.Foldable t)- => (a -> a -> a) -> mono -> a+ => (Element mono -> Element mono -> Element mono) -> mono -> Element mono ofoldl1Ex' = F.foldl1 {-# INLINE ofoldl1Ex' #-} @@ -364,7 +430,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. --- -- /See 'Data.NonNull.last from "Data.NonNull" for a total version of this function./+ -- /See 'Data.NonNull.last' from "Data.NonNull" for a total version of this function./ lastEx :: mono -> Element mono lastEx = ofoldl1Ex' (flip const) {-# INLINE lastEx #-}@@ -385,7 +451,7 @@ -- Note: this is a partial function. On an empty 'MonoFoldable', it will -- throw an exception. --- -- /See 'Data.NonNull.maximiumBy' from "Data.NonNull" for a total version of this function./+ -- /See 'Data.NonNull.maximumBy' from "Data.NonNull" for a total version of this function./ maximumByEx :: (Element mono -> Element mono -> Ordering) -> mono -> Element mono maximumByEx f = ofoldl1Ex' go@@ -413,6 +479,16 @@ _ -> x {-# INLINE minimumByEx #-} + -- | Checks if the monomorphic container includes the supplied element.+ oelem :: Eq (Element mono) => Element mono -> mono -> Bool+ oelem e = List.elem e . otoList+ {-# INLINE [0] oelem #-}++ -- | Checks if the monomorphic container does not include the supplied element.+ onotElem :: Eq (Element mono) => Element mono -> mono -> Bool+ onotElem e = List.notElem e . otoList+ {-# INLINE [0] onotElem #-}+ instance MonoFoldable S.ByteString where ofoldMap f = ofoldr (mappend . f) mempty ofoldr = S.foldr@@ -422,25 +498,18 @@ oany = S.any onull = S.null olength = S.length+ oelem = S.elem+ onotElem = S.notElem omapM_ f (Unsafe.PS fptr offset len) = do let start = Unsafe.unsafeForeignPtrToPtr fptr `plusPtr` offset end = start `plusPtr` len loop ptr | ptr >= end = evil (touchForeignPtr fptr) `seq`-#if MIN_VERSION_base(4,8,0) pure ()-#else- return ()-#endif | otherwise =-#if MIN_VERSION_base(4,8,0) f (evil (peek ptr)) *> loop (ptr `plusPtr` 1)-#else- f (evil (peek ptr)) >>- loop (ptr `plusPtr` 1)-#endif loop start where #if MIN_VERSION_bytestring(0,10,6)@@ -468,6 +537,8 @@ {-# INLINE headEx #-} {-# INLINE lastEx #-} {-# INLINE unsafeHead #-}+ {-# INLINE oelem #-}+ {-# INLINE onotElem #-} {-# RULES "strict ByteString: ofoldMap = concatMap" ofoldMap = S.concatMap #-} instance MonoFoldable L.ByteString where@@ -484,6 +555,9 @@ ofoldl1Ex' = L.foldl1' headEx = L.head lastEx = L.last+ oelem = L.elem+ onotElem = L.notElem+ {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-} {-# INLINE ofoldl' #-}@@ -497,6 +571,8 @@ {-# INLINE ofoldl1Ex' #-} {-# INLINE headEx #-} {-# INLINE lastEx #-}+ {-# INLINE oelem #-}+ {-# INLINE onotElem #-} {-# RULES "lazy ByteString: ofoldMap = concatMap" ofoldMap = L.concatMap #-} instance MonoFoldable T.Text where@@ -578,11 +654,7 @@ | i Prelude.<= 0 = GT | otherwise = ocompareLength xs (i - 1) instance MonoFoldable (Maybe a) where-#if MIN_VERSION_base(4,8,0) omapM_ _ Nothing = pure ()-#else- omapM_ _ Nothing = return ()-#endif omapM_ f (Just x) = f x {-# INLINE omapM_ #-} instance MonoFoldable (Tree a)@@ -594,10 +666,14 @@ instance MonoFoldable (ViewL a) instance MonoFoldable (ViewR a) instance MonoFoldable (IntMap a)+#if !MIN_VERSION_base(4,16,0) instance MonoFoldable (Option a)+#endif instance MonoFoldable (NonEmpty a) instance MonoFoldable (Identity a)-instance MonoFoldable (Map k v)+instance MonoFoldable (Map k v) where+ olength = Map.size+ {-# INLINE olength #-} instance MonoFoldable (HashMap k v) instance MonoFoldable (Vector a) where ofoldr = V.foldr@@ -629,7 +705,13 @@ {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-}-instance MonoFoldable (Set e)+instance Ord e => MonoFoldable (Set e) where+ olength = Set.size+ oelem = Set.member+ onotElem = Set.notMember+ {-# INLINE olength #-}+ {-# INLINE oelem #-}+ {-# INLINE onotElem #-} instance MonoFoldable (HashSet e) instance U.Unbox a => MonoFoldable (U.Vector a) where@@ -696,6 +778,39 @@ {-# INLINE unsafeHead #-} {-# INLINE maximumByEx #-} {-# INLINE minimumByEx #-}+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance MonoFoldable (VSC.Vector a) where+ ofoldr = VSC.foldr+ ofoldl' = VSC.foldl'+ otoList = VSC.toList+ oall = VSC.all+ oany = VSC.any+ onull = VSC.null+ olength = VSC.length+ ofoldr1Ex = VSC.foldr1+ ofoldl1Ex' = VSC.foldl1'+ headEx = VSC.head+ lastEx = VSC.last+ unsafeHead = VSC.unsafeHead+ unsafeLast = VSC.unsafeLast+ maximumByEx = VSC.maximumBy+ minimumByEx = VSC.minimumBy+ {-# INLINE ofoldr #-}+ {-# INLINE ofoldl' #-}+ {-# INLINE otoList #-}+ {-# INLINE oall #-}+ {-# INLINE oany #-}+ {-# INLINE onull #-}+ {-# INLINE olength #-}+ {-# INLINE ofoldr1Ex #-}+ {-# INLINE ofoldl1Ex' #-}+ {-# INLINE headEx #-}+ {-# INLINE lastEx #-}+ {-# INLINE unsafeHead #-}+ {-# INLINE maximumByEx #-}+ {-# INLINE minimumByEx #-}+#endif instance MonoFoldable (Either a b) where ofoldMap f = ofoldr (mappend . f) mempty ofoldr f b (Right a) = f a b@@ -716,11 +831,7 @@ ofoldr1Ex _ (Right x) = x ofoldl1Ex' _ (Left _) = Prelude.error "ofoldl1Ex' on Either" ofoldl1Ex' _ (Right x) = x-#if MIN_VERSION_base(4,8,0) omapM_ _ (Left _) = pure ()-#else- omapM_ _ (Left _) = return ()-#endif omapM_ f (Right x) = f x {-# INLINE ofoldMap #-} {-# INLINE ofoldr #-}@@ -736,12 +847,41 @@ instance MonoFoldable (a, b) instance MonoFoldable (Const m a) instance F.Foldable f => MonoFoldable (MaybeT f a)+#if !MIN_VERSION_transformers(0,6,0) instance F.Foldable f => MonoFoldable (ListT f a)+#endif instance F.Foldable f => MonoFoldable (IdentityT f a) instance F.Foldable f => MonoFoldable (WriterT w f a) instance F.Foldable f => MonoFoldable (Strict.WriterT w f a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Compose f g a) instance (F.Foldable f, F.Foldable g) => MonoFoldable (Product f g a)+-- | @since 1.0.11.0+instance (F.Foldable f, F.Foldable g) => MonoFoldable ((f :.: g) a)+-- | @since 1.0.11.0+instance (F.Foldable f, F.Foldable g) => MonoFoldable ((f :*: g) a)+-- | @since 1.0.11.0+instance (F.Foldable f, F.Foldable g) => MonoFoldable ((f :+: g) a)+-- | @since 1.0.11.0+instance MonoFoldable (K1 i c a)+-- | @since 1.0.11.0+instance F.Foldable f => MonoFoldable (M1 i c f a)+-- | @since 1.0.11.0+instance F.Foldable f => MonoFoldable (Rec1 f a)+-- | @since 1.0.11.0+instance MonoFoldable (Par1 a)+-- | @since 1.0.11.0+instance MonoFoldable (U1 a)+-- | @since 1.0.11.0+instance MonoFoldable (V1 a)+-- | @since 1.0.11.0+instance MonoFoldable (Proxy a)+-- | @since 1.0.20.0+instance MonoFoldable (f a) => MonoFoldable (Reverse f a) where+ ofoldMap f (Reverse t) = getDual (ofoldMap (Dual . f) t)+ ofoldr f z (Reverse t) = ofoldl' (flip f) z t+ ofoldl' f z (Reverse t) = ofoldr (flip f) z t+ ofoldr1Ex f (Reverse t) = ofoldl1Ex' (flip f) t+ ofoldl1Ex' f (Reverse t) = ofoldr1Ex (flip f) t -- | Safe version of 'headEx'. --@@ -775,14 +915,14 @@ -- | Are __all__ of the elements 'True'? ----- Since 0.6.0+-- @since 0.6.0 oand :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool oand = oall id {-# INLINE oand #-} -- | Are __any__ of the elements 'True'? ----- Since 0.6.0+-- @since 0.6.0 oor :: (Element mono ~ Bool, MonoFoldable mono) => mono -> Bool oor = oany id {-# INLINE oor #-}@@ -817,33 +957,10 @@ -- | Perform all actions in the given container -- -- @since 1.0.0-#if MIN_VERSION_base(4,8,0) osequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m ()-#else-osequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m ()-#endif osequence_ = omapM_ id {-# INLINE osequence_ #-} --- | Checks if the monomorphic container includes the supplied element.-oelem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool-oelem e = List.elem e . otoList-{-# INLINE [0] oelem #-}---- | Checks if the monomorphic container does not include the supplied element.-onotElem :: (MonoFoldable mono, Eq (Element mono)) => Element mono -> mono -> Bool-onotElem e = List.notElem e . otoList-{-# INLINE [0] onotElem #-}--{-# RULES "strict ByteString elem" oelem = S.elem #-}-{-# RULES "strict ByteString notElem" oelem = S.notElem #-}--{-# RULES "lazy ByteString elem" oelem = L.elem #-}-{-# RULES "lazy ByteString notElem" oelem = L.notElem #-}--{-# RULES "Set elem" forall (k :: Ord k => k). oelem k = Set.member k #-}-{-# RULES "Set notElem" forall (k :: Ord k => k). oelem k = Set.notMember k #-}- -- | Get the minimum element of a monomorphic container. -- -- Note: this is a partial function. On an empty 'MonoFoldable', it will@@ -932,6 +1049,9 @@ {-# INLINE minimumByMay #-} -- | Monomorphic containers that can be traversed from left to right.+--+-- NOTE: Due to limitations with the role system, GHC is yet unable to provide newtype-derivation of+-- 'MonoTraversable'. See <https://stackoverflow.com/questions/49776924/newtype-deriving-issequence>. class (MonoFunctor mono, MonoFoldable mono) => MonoTraversable mono where -- | Map each element of a monomorphic container to an action, -- evaluate these actions from left to right, and@@ -943,45 +1063,23 @@ -- | Map each element of a monomorphic container to a monadic action, -- evaluate these actions from left to right, and -- collect the results.-#if MIN_VERSION_base(4,8,0) omapM :: Applicative m => (Element mono -> m (Element mono)) -> mono -> m mono omapM = otraverse-#else- omapM :: Monad m => (Element mono -> m (Element mono)) -> mono -> m mono- default omapM :: (Traversable t, mono ~ t a, a ~ Element mono, Monad m) => (Element mono -> m (Element mono)) -> mono -> m mono- omapM = mapM-#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable S.ByteString where otraverse f = fmap S.pack . traverse f . S.unpack {-# INLINE otraverse #-}-#if !MIN_VERSION_base(4,8,0)- omapM f = liftM S.pack . mapM f . S.unpack- {-# INLINE omapM #-}-#endif instance MonoTraversable L.ByteString where otraverse f = fmap L.pack . traverse f . L.unpack {-# INLINE otraverse #-}-#if !MIN_VERSION_base(4,8,0)- omapM f = liftM L.pack . mapM f . L.unpack- {-# INLINE omapM #-}-#endif instance MonoTraversable T.Text where otraverse f = fmap T.pack . traverse f . T.unpack {-# INLINE otraverse #-}-#if !MIN_VERSION_base(4,8,0)- omapM f = liftM T.pack . mapM f . T.unpack- {-# INLINE omapM #-}-#endif instance MonoTraversable TL.Text where otraverse f = fmap TL.pack . traverse f . TL.unpack {-# INLINE otraverse #-}-#if !MIN_VERSION_base(4,8,0)- omapM f = liftM TL.pack . mapM f . TL.unpack- {-# INLINE omapM #-}-#endif instance MonoTraversable [a] instance MonoTraversable (Maybe a) instance MonoTraversable (Tree a)@@ -989,7 +1087,9 @@ instance MonoTraversable (ViewL a) instance MonoTraversable (ViewR a) instance MonoTraversable (IntMap a)+#if !MIN_VERSION_base(4,16,0) instance MonoTraversable (Option a)+#endif instance MonoTraversable (NonEmpty a) instance MonoTraversable (Identity a) instance MonoTraversable (Map k v)@@ -998,44 +1098,60 @@ instance U.Unbox a => MonoTraversable (U.Vector a) where -- FIXME do something more efficient otraverse f = fmap U.fromList . traverse f . U.toList-#if MIN_VERSION_base(4,8,0) omapM = otraverse-#else- omapM = U.mapM-#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance VS.Storable a => MonoTraversable (VS.Vector a) where -- FIXME do something more efficient otraverse f = fmap VS.fromList . traverse f . VS.toList-#if MIN_VERSION_base(4,8,0) omapM = otraverse-#else- omapM = VS.mapM-#endif {-# INLINE otraverse #-} {-# INLINE omapM #-}+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance MonoTraversable (VSC.Vector a)+#endif instance MonoTraversable (Either a b) where otraverse _ (Left a) = pure (Left a) otraverse f (Right b) = fmap Right (f b)-#if MIN_VERSION_base(4,8,0) omapM _ (Left a) = pure (Left a) omapM f (Right b) = fmap Right (f b)-#else- omapM _ (Left a) = return (Left a)- omapM f (Right b) = liftM Right (f b)-#endif {-# INLINE otraverse #-} {-# INLINE omapM #-} instance MonoTraversable (a, b) instance MonoTraversable (Const m a) instance Traversable f => MonoTraversable (MaybeT f a)+#if !MIN_VERSION_transformers(0,6,0) instance Traversable f => MonoTraversable (ListT f a)+#endif instance Traversable f => MonoTraversable (IdentityT f a) instance Traversable f => MonoTraversable (WriterT w f a) instance Traversable f => MonoTraversable (Strict.WriterT w f a) instance (Traversable f, Traversable g) => MonoTraversable (Compose f g a) instance (Traversable f, Traversable g) => MonoTraversable (Product f g a)+-- | @since 1.0.11.0+instance (Traversable f, Traversable g) => MonoTraversable ((f :.: g) a)+-- | @since 1.0.11.0+instance (Traversable f, Traversable g) => MonoTraversable ((f :*: g) a)+-- | @since 1.0.11.0+instance (Traversable f, Traversable g) => MonoTraversable ((f :+: g) a)+-- | @since 1.0.11.0+instance MonoTraversable (K1 i c a)+-- | @since 1.0.11.0+instance Traversable f => MonoTraversable (M1 i c f a)+-- | @since 1.0.11.0+instance Traversable f => MonoTraversable (Rec1 f a)+-- | @since 1.0.11.0+instance MonoTraversable (Par1 a)+-- | @since 1.0.11.0+instance MonoTraversable (U1 a)+-- | @since 1.0.11.0+instance MonoTraversable (V1 a)+-- | @since 1.0.11.0+instance MonoTraversable (Proxy a)+-- | @since 1.0.20.0+instance (MonoTraversable (f a)) => MonoTraversable (Reverse f a) where+ otraverse f (Reverse t) = (fmap Reverse . forwards) (otraverse (Backwards . f) t) -- | 'ofor' is 'otraverse' with its arguments flipped. ofor :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono@@ -1043,11 +1159,7 @@ {-# INLINE ofor #-} -- | 'oforM' is 'omapM' with its arguments flipped.-#if MIN_VERSION_base(4,8,0) oforM :: (MonoTraversable mono, Applicative f) => mono -> (Element mono -> f (Element mono)) -> f mono-#else-oforM :: (MonoTraversable mono, Monad f) => mono -> (Element mono -> f (Element mono)) -> f mono-#endif oforM = flip omapM {-# INLINE oforM #-} @@ -1057,7 +1169,7 @@ -- expected type. It is provided mainly for integration with the @foldl@ -- package, to be used in conjunction with @purely@. ----- Since 0.3.1+-- @since 0.3.1 ofoldlUnwrap :: MonoFoldable mono => (x -> Element mono -> x) -> x -> (x -> b) -> mono -> b ofoldlUnwrap f x unwrap mono = unwrap (ofoldl' f x mono)@@ -1067,7 +1179,7 @@ -- Similar to 'foldlUnwrap', but allows monadic actions. To be used with -- @impurely@ from @foldl@. ----- Since 0.3.1+-- @since 0.3.1 ofoldMUnwrap :: (Monad m, MonoFoldable mono) => (x -> Element mono -> m x) -> m x -> (x -> m b) -> mono -> m b ofoldMUnwrap f mx unwrap mono = do@@ -1100,17 +1212,27 @@ instance MonoPointed L.ByteString where opoint = L.singleton {-# INLINE opoint #-}+-- | @since 1.0.16.0+instance MonoPointed B.Builder where+ opoint = B.word8+ {-# INLINE opoint #-} instance MonoPointed T.Text where opoint = T.singleton {-# INLINE opoint #-} instance MonoPointed TL.Text where opoint = TL.singleton {-# INLINE opoint #-}+-- | @since 1.0.18.0+instance MonoPointed TB.Builder where+ opoint = TB.singleton+ {-# INLINE opoint #-} -- Applicative instance MonoPointed [a] instance MonoPointed (Maybe a)+#if !MIN_VERSION_base(4,16,0) instance MonoPointed (Option a)+#endif instance MonoPointed (NonEmpty a) instance MonoPointed (Identity a) instance MonoPointed (Vector a)@@ -1120,7 +1242,9 @@ instance Monoid a => MonoPointed (a, b) instance Monoid m => MonoPointed (Const m a) instance Monad m => MonoPointed (WrappedMonad m a)+#if !MIN_VERSION_transformers(0,6,0) instance Applicative m => MonoPointed (ListT m a)+#endif instance Applicative m => MonoPointed (IdentityT m a) instance Arrow a => MonoPointed (WrappedArrow a b c) instance (Monoid w, Applicative m) => MonoPointed (WriterT w m a)@@ -1129,6 +1253,20 @@ instance MonoPointed (ContT r m a) instance (Applicative f, Applicative g) => MonoPointed (Compose f g a) instance (Applicative f, Applicative g) => MonoPointed (Product f g a)+-- | @since 1.0.11.0+instance (Applicative f, Applicative g) => MonoPointed ((f :.: g) a)+-- | @since 1.0.11.0+instance (Applicative f, Applicative g) => MonoPointed ((f :*: g) a)+-- | @since 1.0.11.0+instance Applicative f => MonoPointed (M1 i c f a)+-- | @since 1.0.11.0+instance Applicative f => MonoPointed (Rec1 f a)+-- | @since 1.0.11.0+instance MonoPointed (Par1 a)+-- | @since 1.0.11.0+instance MonoPointed (U1 a)+-- | @since 1.0.11.0+instance MonoPointed (Proxy a) -- Not Applicative instance MonoPointed (Seq a) where@@ -1140,6 +1278,10 @@ instance VS.Storable a => MonoPointed (VS.Vector a) where opoint = VS.singleton {-# INLINE opoint #-}+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance MonoPointed (VSC.Vector a)+#endif instance MonoPointed (Either a b) where opoint = Right {-# INLINE opoint #-}@@ -1176,6 +1318,10 @@ instance MonoPointed (Tree a) where opoint a = Node a [] {-# INLINE opoint #-}+-- | @since 1.0.11.0+instance (Applicative f, Applicative g) => MonoPointed ((f :+: g) a) where+ opoint = R1 . pure+ {-# INLINE opoint #-} -- | Typeclass for monomorphic containers where it is always okay to@@ -1207,7 +1353,7 @@ instance MonoComonad (ViewL a) where oextract ~(x :< _) = x {-# INLINE oextract #-}- oextend f w@ ~(_ :< xxs) =+ oextend f w@(~(_ :< xxs)) = f w :< case Seq.viewl xxs of EmptyL -> Seq.empty xs -> case oextend f xs of@@ -1217,7 +1363,7 @@ instance MonoComonad (ViewR a) where oextract ~(_ :> x) = x {-# INLINE oextract #-}- oextend f w@ ~(xxs :> _) =+ oextend f w@(~(xxs :> _)) = (case Seq.viewr xxs of EmptyR -> Seq.empty xs -> case oextend f xs of@@ -1246,6 +1392,10 @@ instance GrowingAppend (V.Vector a) instance U.Unbox a => GrowingAppend (U.Vector a) instance VS.Storable a => GrowingAppend (VS.Vector a)+#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance GrowingAppend (VSC.Vector a)+#endif instance GrowingAppend S.ByteString instance GrowingAppend L.ByteString instance GrowingAppend T.Text@@ -1278,3 +1428,127 @@ ointercalate x = T.intercalate x . otoList #-} {-# RULES "intercalate LText" forall x. ointercalate x = TL.intercalate x . otoList #-}++-- | Provides a `MonoFoldable`, `MonoFunctor` or `MonoPointed` for an arbitrary+-- `F.Foldable`, `Functor` or `Applicative`.+--+-- Useful for, e.g., passing a `F.Foldable` type you don't own into a+-- function that expects a `MonoFoldable`.+--+-- > // package A+-- > data MyList a = MyList [a] deriving Foldable+-- >+-- > // package B+-- > process :: MonoFoldable mono => mono -> IO ()+-- >+-- > // package C+-- > process (WrappedPoly (MyList []))+--+-- @since 1.0.13.0+newtype WrappedPoly f a = WrappedPoly { unwrapPoly :: f a }+ deriving newtype (F.Foldable, Functor, Applicative, Monad)++type instance Element (WrappedPoly f a) = a+instance F.Foldable f => MonoFoldable (WrappedPoly f a)+instance Functor f => MonoFunctor (WrappedPoly f a)+instance Applicative f => MonoPointed (WrappedPoly f a)+++-- | Provides a `F.Foldable` for an arbitrary `MonoFoldable`.+--+-- @since 1.0.14.0+data WrappedMono mono a where+ WrappedMono :: Element mono ~ a => mono -> WrappedMono mono a++-- | Unwraps a `WrappedMono`.+--+-- @since 1.0.14.0+unwrapMono :: WrappedMono mono a -> mono+unwrapMono (WrappedMono mono) = mono+{-# INLINE unwrapMono #-}++type instance Element (WrappedMono mono a) = Element mono++instance MonoFoldable mono => MonoFoldable (WrappedMono mono a) where+ ofoldMap f = ofoldMap f . unwrapMono+ {-# INLINE ofoldMap #-}+ ofoldr f z = ofoldr f z . unwrapMono+ {-# INLINE ofoldr #-}+ ofoldl' f z = ofoldl' f z . unwrapMono+ {-# INLINE ofoldl' #-}+ otoList = otoList . unwrapMono+ {-# INLINE otoList #-}+ oall f = oall f . unwrapMono+ {-# INLINE oall #-}+ oany f = oany f . unwrapMono+ {-# INLINE oany #-}+ onull = onull . unwrapMono+ {-# INLINE onull #-}+ olength = olength . unwrapMono+ {-# INLINE olength #-}+ olength64 = olength64 . unwrapMono+ {-# INLINE olength64 #-}+ ocompareLength mono i = ocompareLength (unwrapMono mono) i+ {-# INLINE ocompareLength #-}+ otraverse_ f = otraverse_ f . unwrapMono+ {-# INLINE otraverse_ #-}+ ofor_ mono f = ofor_ (unwrapMono mono) f+ {-# INLINE ofor_ #-}+ omapM_ f = omapM_ f . unwrapMono+ {-# INLINE omapM_ #-}+ oforM_ mono f = oforM_ (unwrapMono mono) f+ {-# INLINE oforM_ #-}+ ofoldlM f z = ofoldlM f z . unwrapMono+ {-# INLINE ofoldlM #-}+ ofoldMap1Ex f = ofoldMap1Ex f . unwrapMono+ {-# INLINE ofoldMap1Ex #-}+ ofoldr1Ex f = ofoldr1Ex f . unwrapMono+ {-# INLINE ofoldr1Ex #-}+ ofoldl1Ex' f = ofoldl1Ex' f . unwrapMono+ {-# INLINE ofoldl1Ex' #-}+ headEx = headEx . unwrapMono+ {-# INLINE headEx #-}+ lastEx = lastEx . unwrapMono+ {-# INLINE lastEx #-}+ unsafeHead = unsafeHead . unwrapMono+ {-# INLINE unsafeHead #-}+ unsafeLast = unsafeLast . unwrapMono+ {-# INLINE unsafeLast #-}+ maximumByEx f = maximumByEx f . unwrapMono+ {-# INLINE maximumByEx #-}+ minimumByEx f = minimumByEx f . unwrapMono+ {-# INLINE minimumByEx #-}+ oelem a = oelem a . unwrapMono+ {-# INLINE oelem #-}+ onotElem a = onotElem a . unwrapMono+ {-# INLINE onotElem #-}++instance MonoFunctor mono => MonoFunctor (WrappedMono mono a) where+ omap f (WrappedMono mono) = WrappedMono (omap f mono)+ {-# INLINE omap #-}++instance (MonoPointed mono, Element mono ~ a) => MonoPointed (WrappedMono mono a) where+ opoint a = WrappedMono (opoint a)+ {-# INLINE opoint #-}++instance MonoFoldable mono => F.Foldable (WrappedMono mono) where+ foldr f zero (WrappedMono mono) = ofoldr f zero mono+ {-# INLINE foldr #-}+ foldMap f (WrappedMono mono) = ofoldMap f mono+ {-# INLINE foldMap #-}+ foldl' f z (WrappedMono mono) = ofoldl' f z mono+ {-# INLINE foldl' #-}+ foldl1 f (WrappedMono mono) = ofoldl1Ex' f mono+ {-# INLINE foldl1 #-}+ toList (WrappedMono mono) = otoList mono+ {-# INLINE toList #-}+ null (WrappedMono mono) = onull mono+ {-# INLINE null #-}+ length (WrappedMono mono) = olength mono+ {-# INLINE length #-}+ elem a (WrappedMono mono) = oelem a mono+ {-# INLINE elem #-}+ maximum (WrappedMono mono) = maximumEx mono+ {-# INLINE maximum #-}+ minimum (WrappedMono mono) = minimumEx mono+ {-# INLINE minimum #-}
src/Data/MonoTraversable/Unprefixed.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} -- | The functions in "Data.MonoTraversable" are all prefixed with the letter -- @o@ to avoid conflicts with their polymorphic counterparts. This module -- exports the same identifiers without the prefix, for all cases where the@@ -14,7 +15,6 @@ import Data.Int (Int64) import Data.MonoTraversable-import Data.Semigroup (Semigroup) import Data.Monoid (Monoid) import Control.Applicative (Applicative) @@ -93,25 +93,15 @@ -- | Synonym for 'omapM_' -- -- @since 1.0.0-#if MIN_VERSION_base(4,8,0) mapM_ :: (MonoFoldable mono, Applicative m) => (Element mono -> m ()) -> mono -> m ()-#else-mapM_ :: (MonoFoldable mono, Monad m)- => (Element mono -> m ()) -> mono -> m ()-#endif mapM_ = omapM_ -- | Synonym for 'oforM_' -- -- @since 1.0.0-#if MIN_VERSION_base(4,8,0) forM_ :: (MonoFoldable mono, Applicative m) => mono -> (Element mono -> m ()) -> m ()-#else-forM_ :: (MonoFoldable mono, Monad m)- => mono -> (Element mono -> m ()) -> m ()-#endif forM_ = oforM_ -- | Synonym for 'ofoldlM'@@ -227,9 +217,5 @@ -- | Synonym for 'osequence_' -- -- @since 1.0.0-#if MIN_VERSION_base(4,8,0) sequence_ :: (Applicative m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m ()-#else-sequence_ :: (Monad m, MonoFoldable mono, Element mono ~ (m ())) => mono -> m ()-#endif sequence_ = osequence_
src/Data/NonNull.hs view
@@ -16,6 +16,7 @@ , nonNull , toNullable , fromNonEmpty+ , toNonEmpty , ncons , nuncons , splitFirst@@ -36,21 +37,18 @@ , minimumBy , (<|) , toMinList+ , mapNonNull , GrowingAppend ) where import Prelude hiding (head, tail, init, last, reverse, seq, filter, replicate, maximum, minimum) import Control.Arrow (second) import Control.Exception.Base (Exception, throw)-#if !MIN_VERSION_base(4,8,0)-import Control.Monad (liftM)-#endif import Data.Data import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.MonoTraversable import Data.Sequences-import Data.Semigroup (Semigroup (..)) import Control.Monad.Trans.State.Strict (evalState, state) data NullError = NullError String deriving (Show, Typeable)@@ -68,10 +66,7 @@ instance MonoTraversable mono => MonoTraversable (NonNull mono) where otraverse f (NonNull x) = fmap NonNull (otraverse f x) {-# INLINE otraverse #-}-#if !MIN_VERSION_base(4,8,0)- omapM f (NonNull x) = liftM NonNull (omapM f x)- {-# INLINE omapM #-}-#endif+ instance GrowingAppend mono => GrowingAppend (NonNull mono) instance (Semigroup mono, GrowingAppend mono) => Semigroup (NonNull mono) where@@ -131,6 +126,12 @@ fromNonEmpty = impureNonNull . fromList . NE.toList {-# INLINE fromNonEmpty #-} +-- | __Safely__ convert from a 'NonNull' container to a 'NonEmpty' list.+--+-- @since 1.0.15.0+toNonEmpty :: MonoFoldable mono => NonNull mono -> NE.NonEmpty (Element mono)+toNonEmpty = NE.fromList . otoList+ -- | Specializes 'fromNonEmpty' to lists only. toMinList :: NE.NonEmpty a -> NonNull [a] toMinList = fromNonEmpty@@ -144,11 +145,11 @@ -- -- * if you don't need to cons, use 'fromNullable' or 'nonNull' if you can create your structure in one go. -- * if you need to cons, you might be able to start off with an efficient data structure such as a 'NonEmpty' List.--- 'fronNonEmpty' will convert that to your data structure using the structure's fromList function.+-- 'fromNonEmpty' will convert that to your data structure using the structure's fromList function. ncons :: SemiSequence seq => Element seq -> seq -> NonNull seq ncons x xs = nonNull $ cons x xs --- | Extract the first element of a sequnce and the rest of the non-null sequence if it exists.+-- | Extract the first element of a sequence and the rest of the non-null sequence if it exists. nuncons :: IsSequence seq => NonNull seq -> (Element seq, Maybe (NonNull seq)) nuncons xs = second fromNullable@@ -161,17 +162,17 @@ fromMaybe (error "Data.NonNull.splitFirst: data structure is null, it should be non-null") $ uncons (toNullable xs) --- | Equivalent to @"Data.Sequence".'Data.Sequence.filter'@,+-- | Equivalent to @"Data.Sequences".'Data.Sequences.filter'@, -- but works on non-nullable sequences. nfilter :: IsSequence seq => (Element seq -> Bool) -> NonNull seq -> seq nfilter f = filter f . toNullable --- | Equivalent to @"Data.Sequence".'Data.Sequence.filterM'@,+-- | Equivalent to @"Data.Sequences".'Data.Sequences.filterM'@, -- but works on non-nullable sequences. nfilterM :: (Monad m, IsSequence seq) => (Element seq -> m Bool) -> NonNull seq -> m seq nfilterM f = filterM f . toNullable --- | Equivalent to @"Data.Sequence".'Data.Sequence.replicate'@+-- | Equivalent to @"Data.Sequences".'Data.Sequences.replicate'@ -- -- @i@ must be @> 0@ --@@ -348,3 +349,20 @@ -> Element mono minimumBy cmp = minimumByEx cmp . toNullable {-# INLINE minimumBy #-}++-- | 'fmap' over the underlying container in a 'NonNull'.+--+-- @since 1.0.6.0++-- ==== __Examples__+--+-- @+-- > let xs = 'ncons' 1 [2, 3 :: Int]+-- > 'mapNonNull' 'show' xs+-- 'NonNull' {toNullable = [\"1\",\"2\",\"3\"]}+-- @+mapNonNull :: (Functor f, MonoFoldable (f b))+ => (a -> b)+ -> NonNull (f a)+ -> NonNull (f b)+mapNonNull f = impureNonNull . fmap f . toNullable
src/Data/Sequences.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}@@ -5,17 +6,18 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeOperators #-} -- | Abstractions over sequential data structures, like lists and vectors. module Data.Sequences where -import Data.Maybe (fromJust, isJust)-import Data.Monoid (Monoid, mconcat, mempty)+import Data.Maybe (fromJust, fromMaybe, isJust)+import Data.Monoid (Monoid, mconcat, mempty, (<>)) import Data.MonoTraversable import Data.Int (Int64, Int) import qualified Data.List as List import qualified Data.List.Split as List import qualified Control.Monad (filterM, replicateM)-import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), fst, snd, Integral, ($), flip, maybe, error)+import Prelude (Bool (..), Monad (..), Maybe (..), Ordering (..), Ord (..), Eq (..), Functor (..), fromIntegral, otherwise, (-), fst, snd, Integral, ($), flip, maybe, error, (||)) import Data.Char (Char, isSpace) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -28,6 +30,11 @@ import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Storable as VS+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VSC+#else+{-# DependencyDeprecation "Support for vector < 0.13.2 will be removed when GHC 9.12 reaches Stackage nightly. Please upgrade to vector >= 0.13.2." #-}+#endif import Data.String (IsString) import qualified Data.List.NonEmpty as NE import qualified Data.ByteString.Unsafe as SU@@ -42,7 +49,7 @@ -- | 'SemiSequence' was created to share code between 'IsSequence' and 'NonNull'. -- -- @Semi@ means 'SemiGroup'--- A 'SemiSequence' can accomodate a 'SemiGroup' such as 'NonEmpty' or 'NonNull'+-- A 'SemiSequence' can accommodate a 'SemiGroup' such as 'NonEmpty' or 'NonNull' -- A Monoid should be able to fill out 'IsSequence'. -- -- 'SemiSequence' operations maintain the same type because they all maintain the same number of elements or increase them.@@ -122,7 +129,7 @@ -- > 'singleton' 'a' :: 'Vector' 'Char' -- 'Data.Vector.fromList' "a" -- @-singleton :: IsSequence seq => Element seq -> seq+singleton :: MonoPointed seq => Element seq -> seq singleton = opoint {-# INLINE singleton #-} @@ -145,8 +152,14 @@ -- However, all the instances define their own fromList fromList = mconcat . fmap singleton - -- below functions change type fron the perspective of NonEmpty+ -- | 'lengthIndex' returns the length of a sequence as @'Index' seq@.+ --+ -- @since 1.0.2+ lengthIndex :: seq -> Index seq;+ lengthIndex = fromIntegral . olength64; + -- below functions change type from the perspective of NonEmpty+ -- | 'break' applies a predicate to a sequence, and returns a tuple where -- the first element is the longest prefix (possibly empty) of elements that -- /do not satisfy/ the predicate. The second element of the tuple is the@@ -263,6 +276,19 @@ unsafeDrop :: Index seq -> seq -> seq unsafeDrop = drop + -- | Same as 'drop' but drops from the end of the sequence instead.+ --+ -- @+ -- > 'dropEnd' 3 "abcdefg"+ -- "abcd"+ -- > 'dropEnd' 4 ('fromList' [1,2,3,4,5,6] :: 'Vector' 'Int')+ -- fromList [1,2]+ -- @+ --+ -- @since 1.0.4.0+ dropEnd :: Index seq -> seq -> seq+ dropEnd i s = fst $ splitAt (lengthIndex s - i) s+ -- | 'partition' takes a predicate and a sequence and returns the pair of -- sequences of elements which do and do not satisfy the predicate. --@@ -289,10 +315,10 @@ -- or 'Nothing' if the sequence is empty. -- -- @- -- > 'uncons' ('fromList' [1,2,3,4] :: 'Vector' 'Int')+ -- > 'unsnoc' ('fromList' [1,2,3,4] :: 'Vector' 'Int') -- 'Just' (fromList [1,2,3],4) --- -- > 'uncons' ([] :: ['Int'])+ -- > 'unsnoc' ([] :: ['Int']) -- 'Nothing' -- @ unsnoc :: seq -> Maybe (seq, Element seq)@@ -404,7 +430,7 @@ -- an empty monomorphic container. -- -- @since 1.0.0- initMay :: IsSequence seq => seq -> Maybe seq+ initMay :: seq -> Maybe seq initMay seq | onull seq = Nothing | otherwise = Just (initEx seq)@@ -428,7 +454,9 @@ -- 'Nothing' -- @ index :: seq -> Index seq -> Maybe (Element seq)- index seq' idx = headMay (drop idx seq')+ index seq' idx+ | idx < 0 = Nothing+ | otherwise = headMay (drop idx seq') -- | __Unsafe__ --@@ -451,6 +479,47 @@ splitWhen :: (Element seq -> Bool) -> seq -> [seq] splitWhen = defaultSplitWhen + -- | Returns all the final segments of 'seq' with the longest first.+ --+ -- @+ -- > tails [1,2]+ -- [[1,2],[2],[]]+ -- > tails []+ -- [[]]+ -- @+ --+ -- @since 1.0.17.0+ tails :: seq -> [seq]+ tails x = x : maybe mempty tails (tailMay x)++ -- | Return all the initial segments of 'seq' with the shortest first.+ --+ -- @+ -- > inits [1,2]+ -- [[],[1],[1,2]]+ -- > inits []+ -- [[]]+ -- @+ --+ -- @since 1.0.17.0+ inits :: seq -> [seq]+ inits seq = is seq [seq]+ where+ is = maybe id (\x -> is x . (x :)) . initMay++ -- | Return all the pairs of inital and final segments of 'seq'.+ --+ -- @+ -- > initTails [1,2]+ -- [([],[1,2]),([1],[2]),([1,2],[])]+ -- > initTails []+ -- [([],[])]+ -- @+ --+ -- @since 1.0.17.0+ initTails :: seq -> [(seq,seq)]+ initTails seq = List.zip (inits seq) (tails seq)+ {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-}@@ -481,6 +550,9 @@ {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} {-# INLINE splitWhen #-}+ {-# INLINE tails #-}+ {-# INLINE inits #-}+ {-# INLINE initTails #-} -- | Use "Data.List"'s implementation of 'Data.List.find'. defaultFind :: MonoFoldable seq => (Element seq -> Bool) -> seq -> Maybe (Element seq)@@ -558,6 +630,7 @@ instance IsSequence [a] where fromList = id+ lengthIndex = List.length filter = List.filter filterM = Control.Monad.filterM break = List.break@@ -585,6 +658,13 @@ (matches, nonMatches) = partition ((== f head) . f) tail groupAllOn _ [] = [] splitWhen = List.splitWhen+ tails = List.tails+ inits = List.inits+ initTails = its id+ where+ its :: ([a] -> [a]) -> [a] -> [([a],[a])]+ its f xs@(y:ys) = (f [], xs) : its (f . (y:)) ys+ its f [] = [(f [], [])] {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-}@@ -603,6 +683,9 @@ {-# INLINE groupBy #-} {-# INLINE groupAllOn #-} {-# INLINE splitWhen #-}+ {-# INLINE tails #-}+ {-# INLINE inits #-}+ {-# INLINE initTails #-} instance SemiSequence (NE.NonEmpty a) where type Index (NE.NonEmpty a) = Int@@ -637,6 +720,7 @@ instance IsSequence S.ByteString where fromList = S.pack+ lengthIndex = S.length replicate = S.replicate filter = S.filter break = S.break@@ -681,8 +765,8 @@ {-# INLINE splitWhen #-} index bs i- | i >= S.length bs = Nothing- | otherwise = Just (S.index bs i)+ | i < 0 || i >= S.length bs = Nothing+ | otherwise = Just (SU.unsafeIndex bs i) indexEx = S.index unsafeIndex = SU.unsafeIndex {-# INLINE index #-}@@ -706,6 +790,7 @@ instance IsSequence T.Text where fromList = T.pack+ lengthIndex = T.length replicate i c = T.replicate i (T.singleton c) filter = T.filter break = T.break@@ -715,6 +800,7 @@ splitAt = T.splitAt take = T.take drop = T.drop+ dropEnd = T.dropEnd partition = T.partition uncons = T.uncons unsnoc t@@ -743,7 +829,7 @@ {-# INLINE splitWhen #-} index t i- | i >= T.length t = Nothing+ | i < 0 || i >= T.length t = Nothing | otherwise = Just (T.index t i) indexEx = T.index unsafeIndex = T.index@@ -768,6 +854,7 @@ instance IsSequence L.ByteString where fromList = L.pack+ lengthIndex = L.length replicate = L.replicate filter = L.filter break = L.break@@ -827,6 +914,7 @@ instance IsSequence TL.Text where fromList = TL.pack+ lengthIndex = TL.length replicate i c = TL.replicate i (TL.singleton c) filter = TL.filter break = TL.break@@ -886,6 +974,7 @@ instance IsSequence (Seq.Seq a) where fromList = Seq.fromList+ lengthIndex = Seq.length replicate = Seq.replicate replicateM = Seq.replicateM filter = Seq.filter@@ -926,15 +1015,19 @@ {-# INLINE tailEx #-} {-# INLINE initEx #-} - index seq' i- | i >= Seq.length seq' = Nothing- | otherwise = Just (Seq.index seq' i)+ index = (Seq.!?) indexEx = Seq.index unsafeIndex = Seq.index {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = its . (,) mempty+ where+ its x@(is, y Seq.:<| ts) = x : its (is Seq.:|> y, ts)+ its x@(_, Seq.Empty) = [x]+ {-# INLINE initTails #-}+ instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int reverse = V.reverse@@ -953,6 +1046,7 @@ instance IsSequence (V.Vector a) where fromList = V.fromList+ lengthIndex = V.length replicate = V.replicate replicateM = V.replicateM filter = V.filter@@ -1000,15 +1094,91 @@ {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} - index v i- | i >= V.length v = Nothing- | otherwise = Just (v V.! i)+ index = (V.!?) indexEx = (V.!) unsafeIndex = V.unsafeIndex {-# INLINE index #-} {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} +#if MIN_VERSION_vector(0,13,2)+-- | @since 1.0.21.0+instance SemiSequence (VSC.Vector a) where+ type Index (VSC.Vector a) = Int+ reverse = VSC.reverse+ find = VSC.find+ cons = VSC.cons+ snoc = VSC.snoc++ sortBy = vectorSortBy+ intersperse = defaultIntersperse+ {-# INLINE intersperse #-}+ {-# INLINE reverse #-}+ {-# INLINE find #-}+ {-# INLINE sortBy #-}+ {-# INLINE cons #-}+ {-# INLINE snoc #-}++-- | @since 1.0.21.0+instance IsSequence (VSC.Vector a) where+ fromList = VSC.fromList+ lengthIndex = VSC.length+ replicate = VSC.replicate+ replicateM = VSC.replicateM+ filter = VSC.filter+ filterM = VSC.filterM+ break = VSC.break+ span = VSC.span+ dropWhile = VSC.dropWhile+ takeWhile = VSC.takeWhile+ splitAt = VSC.splitAt+ take = VSC.take+ drop = VSC.drop+ unsafeTake = VSC.unsafeTake+ unsafeDrop = VSC.unsafeDrop+ partition = VSC.partition+ uncons v+ | VSC.null v = Nothing+ | otherwise = Just (VSC.head v, VSC.tail v)+ unsnoc v+ | VSC.null v = Nothing+ | otherwise = Just (VSC.init v, VSC.last v)+ groupBy = VSC.groupBy+ tailEx = VSC.tail+ initEx = VSC.init+ unsafeTail = VSC.unsafeTail+ unsafeInit = VSC.unsafeInit+ {-# INLINE fromList #-}+ {-# INLINE break #-}+ {-# INLINE span #-}+ {-# INLINE dropWhile #-}+ {-# INLINE takeWhile #-}+ {-# INLINE splitAt #-}+ {-# INLINE take #-}+ {-# INLINE unsafeTake #-}+ {-# INLINE drop #-}+ {-# INLINE unsafeDrop #-}+ {-# INLINE partition #-}+ {-# INLINE uncons #-}+ {-# INLINE unsnoc #-}+ {-# INLINE filter #-}+ {-# INLINE filterM #-}+ {-# INLINE replicate #-}+ {-# INLINE replicateM #-}+ {-# INLINE groupBy #-}+ {-# INLINE tailEx #-}+ {-# INLINE initEx #-}+ {-# INLINE unsafeTail #-}+ {-# INLINE unsafeInit #-}++ index = (VSC.!?)+ indexEx = (VSC.!)+ unsafeIndex = VSC.unsafeIndex+ {-# INLINE index #-}+ {-# INLINE indexEx #-}+ {-# INLINE unsafeIndex #-}+#endif+ instance U.Unbox a => SemiSequence (U.Vector a) where type Index (U.Vector a) = Int @@ -1027,6 +1197,7 @@ instance U.Unbox a => IsSequence (U.Vector a) where fromList = U.fromList+ lengthIndex = U.length replicate = U.replicate replicateM = U.replicateM filter = U.filter@@ -1074,9 +1245,7 @@ {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} - index v i- | i >= U.length v = Nothing- | otherwise = Just (v U.! i)+ index = (U.!?) indexEx = (U.!) unsafeIndex = U.unsafeIndex {-# INLINE index #-}@@ -1101,6 +1270,7 @@ instance VS.Storable a => IsSequence (VS.Vector a) where fromList = VS.fromList+ lengthIndex = VS.length replicate = VS.replicate replicateM = VS.replicateM filter = VS.filter@@ -1148,9 +1318,7 @@ {-# INLINE unsafeTail #-} {-# INLINE unsafeInit #-} - index v i- | i >= VS.length v = Nothing- | otherwise = Just (v VS.! i)+ index = (VS.!?) indexEx = (VS.!) unsafeIndex = VS.unsafeIndex {-# INLINE index #-}@@ -1207,7 +1375,7 @@ -- -- @ -- > 'stripPrefix' "foo" "foobar"--- 'Just' "foo"+-- 'Just' "bar" -- > 'stripPrefix' "abc" "foobar" -- 'Nothing' -- @@@ -1231,6 +1399,61 @@ stripSuffixList :: Eq a => [a] -> [a] -> Maybe [a] stripSuffixList x' y' = fmap reverse (stripPrefix (reverse x') (reverse y')) +-- | 'dropPrefix' drops the given prefix from a sequence. It returns the+-- original sequence if the sequence doesn't start with the given prefix.+--+-- @+-- > 'dropPrefix' \"foo\" \"foobar\"+-- \"bar\"+-- > 'dropPrefix' \"abc\" \"foobar\"+-- \"foobar\"+-- @+--+-- @since 1.0.7.0+dropPrefix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq+dropPrefix x y = fromMaybe y (stripPrefix x y)++-- | 'dropSuffix' drops the given suffix from a sequence. It returns the+-- original sequence if the sequence doesn't end with the given suffix.+--+-- @+-- > 'dropSuffix' \"bar\" \"foobar\"+-- \"foo\"+-- > 'dropSuffix' \"abc\" \"foobar\"+-- \"foobar\"+-- @+--+-- @since 1.0.7.0+dropSuffix :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> seq+dropSuffix x y = fromMaybe y (stripSuffix x y)++-- | 'ensurePrefix' will add a prefix to a sequence if it doesn't+-- exist, and otherwise have no effect.+--+-- @+-- > 'ensurePrefix' "foo" "foobar"+-- "foobar"+-- > 'ensurePrefix' "abc" "foobar"+-- "abcfoobar"+-- @+--+-- @since 1.0.3+ensurePrefix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq+ensurePrefix prefix seq = if isPrefixOf prefix seq then seq else prefix <> seq++-- | Append a suffix to a sequence, unless it already has that suffix.+--+-- @+-- > 'ensureSuffix' "bar" "foobar"+-- "foobar"+-- > 'ensureSuffix' "abc" "foobar"+-- "foobarabc"+-- @+--+-- @since 1.0.3+ensureSuffix :: (Eq (Element seq), IsSequence seq) => seq -> seq -> seq+ensureSuffix suffix seq = if isSuffixOf suffix seq then seq else seq <> suffix+ -- | 'isPrefixOf' takes two sequences and returns 'True' if the first -- sequence is a prefix of the second. isPrefixOf :: (IsSequence seq, Eq (Element seq)) => seq -> seq -> Bool@@ -1379,8 +1602,8 @@ -- > 'sort' [4,3,1,2] -- [1,2,3,4] -- @-sort :: (IsSequence seq, Ord (Element seq)) => seq -> seq-sort = fromList . V.toList . vectorSort . V.fromList . otoList+sort :: (SemiSequence seq, Ord (Element seq)) => seq -> seq+sort = sortBy compare {-# INLINE [0] sort #-} {-# RULES "strict ByteString sort" sort = S.sort #-}@@ -1399,7 +1622,7 @@ -- @ words :: t -> [t] - -- | Join a list of textual sequences using seperating spaces.+ -- | Join a list of textual sequences using separating spaces. -- -- @ -- > 'unwords' ["abc","def","ghi"]
+ test/Main.hs view
@@ -0,0 +1,609 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternSynonyms #-}++module Main where++import Data.MonoTraversable+import Data.Containers+import Data.Sequences+import qualified Data.Sequence as Seq+import qualified Data.NonNull as NN+import Data.Monoid (mempty, mconcat, (<>))+import Data.Maybe (fromMaybe)+import qualified Data.List as List++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.HUnit ((@?=))+import Test.QuickCheck hiding (NonEmptyList(..))+import Test.QuickCheck.Function (pattern Fn)+import qualified Test.QuickCheck.Modifiers as QCM++import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Storable as VS+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VSC+#else+{-# MissingTests "Tests for Data.Vector.Strict are disabled due to vector < 0.13.2. Please upgrade vector to >= 0.13.2 to enable these tests." #-}+#endif+import qualified Data.List.NonEmpty as NE+import qualified Data.Semigroup as SG+import qualified Data.Map as Map+import qualified Data.IntMap as IntMap+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set as Set+import qualified Control.Foldl as Foldl+import Data.String (IsString, fromString)++import Control.Arrow (second)+import Control.Applicative+import Control.Monad.Trans.Writer++import Prelude (Bool (..), ($), IO, Eq (..), fromIntegral, Ord (..), String, mod, Int, Integer, show,+ return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe, Char)+import qualified Prelude++newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a)+ deriving (Show, Eq)+instance Arbitrary a => Arbitrary (NonEmpty' a) where+ arbitrary = NonEmpty' <$> ((NE.:|) <$> arbitrary <*> arbitrary)++-- | Arbitrary newtype for key-value pairs without any duplicate keys+-- and is not empty+newtype DuplPairs k v = DuplPairs { unDupl :: [(k,v)] }+ deriving (Eq, Show)++removeDuplicateKeys :: Ord k => [(k,v)] -> [(k,v)]+removeDuplicateKeys m = go Set.empty m+ where go _ [] = []+ go used ((k,v):xs)+ | k `member` used = go used xs+ | otherwise = (k,v) : go (insertSet k used) xs++instance (Arbitrary k, Arbitrary v, Ord k, Eq v) => Arbitrary (DuplPairs k v) where+ arbitrary = DuplPairs . removeDuplicateKeys <$> arbitrary `suchThat` (/= [])+ shrink (DuplPairs xs) =+ map (DuplPairs . removeDuplicateKeys) $ filter (/= []) $ shrink xs++-- | Arbitrary newtype for small lists whose length is <= 10+--+-- Used for testing 'unionsWith'+newtype SmallList a = SmallList { getSmallList :: [a] }+ deriving (Eq, Show, Ord)++instance (Arbitrary a) => Arbitrary (SmallList a) where+ arbitrary = SmallList <$> arbitrary `suchThat` ((<= 10) . olength)+ shrink (SmallList xs) =+ map SmallList $ filter ((<= 10) . olength) $ shrink xs++-- | Choose a random key from a key-value pair list+indexIn :: (Show k, Testable prop) => [(k,v)] -> (k -> prop) -> Property+indexIn = forAll . elements . map Prelude.fst++-- | Type restricted 'fromList'+fromListAs :: IsSequence a => [Element a] -> a -> a+fromListAs xs _ = fromList xs++-- | Type restricted 'mapFromListAs'+mapFromListAs :: IsMap a => [(ContainerKey a, MapValue a)] -> a -> a+mapFromListAs xs _ = mapFromList xs++instance IsString (V.Vector Char) where fromString = V.fromList+instance IsString (U.Vector Char) where fromString = U.fromList+instance IsString (VS.Vector Char) where fromString = VS.fromList+#if MIN_VERSION_vector(0,13,2)+instance IsString (VSC.Vector Char) where fromString = VSC.fromList+#endif++main :: IO ()+main = hspec $ do+ describe "onull" $ do+ it "works on empty lists" $ onull [] @?= True+ it "works on non-empty lists" $ onull [()] @?= False+ it "works on empty texts" $ onull ("" :: Text) @?= True+ it "works on non-empty texts" $ onull ("foo" :: Text) @?= False++ describe "osum" $ do+ prop "works on lists" $ \(Small x) (Small y) ->+ y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` (2 :: Int))++ describe "oproduct" $ do+ prop "works on lists" $ \(Positive x) (Positive y) ->+ let fact n = oproduct [1..n]+ in (y :: Integer) > (x :: Integer) ==>+ oproduct [x..y] @?= fact y `div` fact (x - 1)++ describe "olength" $ do+ prop "works on lists" $ \(NonNegative i) ->+ olength (replicate i () :: [()]) @?= i+ prop "works on texts" $ \(NonNegative i) ->+ olength (replicate i 'a' :: Text) @?= i+ prop "works on lazy bytestrings" $ \(NonNegative (Small i)) ->+ olength64 (replicate i 6 :: L.ByteString) @?= i++ describe "omap" $ do+ prop "works on lists" $ \xs ->+ omap (+1) xs @?= map (+1) (xs :: [Int])+ prop "works on lazy bytestrings" $ \xs ->+ omap (+1) (fromList xs :: L.ByteString) @?= fromList (map (+1) xs)+ prop "works on texts" $ \xs ->+ omap succ (fromList xs :: Text) @?= fromList (map succ xs)++ describe "oconcatMap" $ do+ prop "works on lists" $ \xs ->+ oconcatMap (: []) xs @?= (xs :: [Int])++ describe "ocompareLength" $ do+ prop "works on lists" $ \(Positive i) j ->+ ocompareLength (replicate i () :: [()]) j @?= compare i j++ describe "groupBy" $ do+ let test name dummy = prop name $ \xs (Fn2 g) -> do+ let seq' = fromListAs xs dummy+ let listDef f = Prelude.fmap fromList . List.groupBy f . otoList+ groupBy (==) seq' @?= listDef (==) seq'+ groupBy (/=) seq' @?= listDef (/=) seq'+ groupBy (<) seq' @?= listDef (<) seq'+ groupBy (>) seq' @?= listDef (>) seq'+ groupBy g seq' @?= listDef g seq'+ test "works on lists" ([] :: [Char])+ test "works on texts" ("" :: Text)+ test "works on strict bytestrings" S.empty+ test "works on lazy bytestrings" L.empty+ test "works on Vector" (V.singleton ('a' :: Char))+ test "works on SVector" (VS.singleton ('a' :: Char))+#if MIN_VERSION_vector(0,13,2)+ test "works on StrictVector" (VSC.singleton ('a' :: Char))+#endif+ test "works on UVector" (U.singleton ('a' :: Char))+ test "works on Seq" (Seq.fromList ['a' :: Char])++ describe "groupAll" $ do+ it "works on lists" $ groupAll ("abcabcabc" :: String) @?= ["aaa", "bbb", "ccc"]+ it "works on texts" $ groupAll ("abcabcabc" :: Text) @?= ["aaa", "bbb", "ccc"]++ describe "unsnoc" $ do+ let test name dummy = prop name $ \(QCM.NonEmpty xs) ->+ let seq' = fromListAs xs dummy+ in case unsnoc seq' of+ Just (y, z) -> do+ y SG.<> singleton z @?= seq'+ snoc y z @?= seq'+ otoList (snoc y z) @?= xs+ Nothing -> expectationFailure "unsnoc returned Nothing"+ test "works on lists" ([] :: [Int])+ test "works on texts" ("" :: Text)+ test "works on lazy bytestrings" L.empty++ describe "index" $ do+ let test name dummy = prop name $+ \i' (QCM.NonEmpty xs) ->+ let seq' = fromListAs xs dummy+ mx = index xs (fromIntegral i)+ i = fromIntegral (i' :: Int)+ in do+ mx @?= index seq' i+ case mx of+ Nothing -> return ()+ Just x -> indexEx seq' i @?= x+ test "works on lists" ([] :: [Int])+ test "works on strict texts" ("" :: Text)+ test "works on lazy texts" ("" :: TL.Text)+ test "works on strict bytestrings" S.empty+ test "works on lazy bytestrings" L.empty+ test "works on Vector" (V.singleton (1 :: Int))+ test "works on SVector" (VS.singleton (1 :: Int))+#if MIN_VERSION_vector(0,13,2)+ test "works on StrictVector" (VSC.singleton (1 :: Int))+#endif+ test "works on UVector" (U.singleton (1 :: Int))+ test "works on Seq" (Seq.fromList [1 :: Int])++ describe "groupAllOn" $ do+ it "works on lists" $+ groupAllOn (`mod` 3) ([1..9] :: [Int]) @?= [[1, 4, 7], [2, 5, 8], [3, 6, 9]]++ describe "breakWord" $ do+ let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) @?= (y, z)+ test "hello world" "hello" "world"+ test "hello world" "hello" "world"+ test "hello\r\nworld" "hello" "world"+ test "hello there world" "hello" "there world"+ test "" "" ""+ test "hello \n\r\t" "hello" ""++ describe "breakLine" $ do+ let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) @?= (y, z)+ test "hello world" "hello world" ""+ test "hello\r\n world" "hello" " world"+ test "hello\n world" "hello" " world"+ test "hello\r world" "hello\r world" ""+ test "hello\r\nworld" "hello" "world"+ test "hello\r\nthere\nworld" "hello" "there\nworld"+ test "hello\n\r\nworld" "hello" "\r\nworld"+ test "" "" ""++ describe "omapM_" $ do+ let test typ dummy = prop typ $ \input ->+ input @?= execWriter (omapM_ (tell . return) (fromListAs input dummy))+ test "works on strict bytestrings" S.empty+ test "works on lazy bytestrings" L.empty+ test "works on strict texts" T.empty+ test "works on lazy texts" TL.empty++ describe "inits" $ do+ let test typ emptyTyp = describe typ $ do+ it "empty" $ inits emptyTyp @?= [""]+ it "one element" $ inits ("a" <> emptyTyp) @?= ["", "a"]+ it "two elements" $ inits ("ab" <> emptyTyp) @?= ["", "a", "ab"]+ test "String" (mempty :: String)+ test "StrictBytestring" S.empty+ test "LazyBytestring" L.empty+ test "StrictText" T.empty+ test "LazyText" TL.empty+ test "Seq" Seq.empty+ test "Vector" (mempty :: V.Vector Char)+ test "Unboxed Vector" (mempty :: U.Vector Char)+ test "Storable Vector" (mempty :: VS.Vector Char)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (mempty :: VSC.Vector Char)+#endif++ describe "tails" $ do+ let test typ emptyTyp = describe typ $ do+ it "empty" $ tails emptyTyp @?= [""]+ it "one element" $ tails ("a" <> emptyTyp) @?= ["a", ""]+ it "two elements" $ tails ("ab" <> emptyTyp) @?= ["ab", "b", ""]+ test "String" (mempty :: String)+ test "StrictBytestring" S.empty+ test "LazyBytestring" L.empty+ test "StrictText" T.empty+ test "LazyText" TL.empty+ test "Seq" Seq.empty+ test "Vector" (mempty :: V.Vector Char)+ test "Unboxed Vector" (mempty :: U.Vector Char)+ test "Storable Vector" (mempty :: VS.Vector Char)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (mempty :: VSC.Vector Char)+#endif++ describe "initTails" $ do+ let test typ emptyTyp = describe typ $ do+ it "empty" $ initTails emptyTyp @?= [("","")]+ it "one element" $ initTails ("a" <> emptyTyp) @?= [("","a"), ("a","")]+ it "two elements" $ initTails ("ab" <> emptyTyp) @?= [("","ab"), ("a","b"), ("ab","")]+ test "String" (mempty :: String)+ test "StrictBytestring" S.empty+ test "LazyBytestring" L.empty+ test "StrictText" T.empty+ test "LazyText" TL.empty+ test "Seq" Seq.empty+ test "Vector" (mempty :: V.Vector Char)+ test "Unboxed Vector" (mempty :: U.Vector Char)+ test "Storable Vector" (mempty :: VS.Vector Char)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (mempty :: VSC.Vector Char)+#endif++ describe "NonNull" $ do+ describe "fromNonEmpty" $ do+ prop "toMinList" $ \(NonEmpty' ne) ->+ (NE.toList ne :: [Int]) @?= NN.toNullable (NN.toMinList ne)+ describe "toNonEmpty" $ do+ it "converts nonnull to nonempty" $ do+ NN.toNonEmpty (NN.impureNonNull [1,2,3]) @?= NE.fromList [1,2,3]++ describe "mapNonNull" $ do+ prop "mapNonNull id == id" $ \x xs ->+ let nonNull = NN.ncons x (xs :: [Int])+ in NN.mapNonNull Prelude.id nonNull @?= nonNull+ prop "mapNonNull (f . g) == mapNonNull f . mapNonNull g" $+ \(Fn (f :: Integer -> String)) (Fn (g :: Int -> Integer)) x xs ->+ let nns = NN.ncons x (xs :: [Int])+ in NN.mapNonNull (f . g) nns @?= NN.mapNonNull f (NN.mapNonNull g nns)++ let -- | Type restricted 'NN.ncons'+ nconsAs :: IsSequence seq => Element seq -> [Element seq] -> seq -> NN.NonNull seq+ nconsAs x xs _ = NN.ncons x (fromList xs)++ test :: (IsSequence typ, Ord (Element typ), Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ))+ => String -> typ -> Spec+ test typ du = describe typ $ do+ prop "head" $ \x xs ->+ NN.head (nconsAs x xs du) @?= x+ prop "tail" $ \x xs ->+ NN.tail (nconsAs x xs du) @?= fromList xs+ prop "last" $ \x xs ->+ NN.last (reverse $ nconsAs x xs du) @?= x+ prop "init" $ \x xs ->+ NN.init (reverse $ nconsAs x xs du) @?= reverse (fromList xs)+ prop "maximum" $ \x xs ->+ NN.maximum (nconsAs x xs du) @?= Prelude.maximum (x:xs)+ prop "maximumBy" $ \x xs ->+ NN.maximumBy compare (nconsAs x xs du) @?= Prelude.maximum (x:xs)+ prop "minimum" $ \x xs ->+ NN.minimum (nconsAs x xs du) @?= Prelude.minimum (x:xs)+ prop "minimumBy" $ \x xs ->+ NN.minimumBy compare (nconsAs x xs du) @?= Prelude.minimum (x:xs)+ prop "ofoldMap1" $ \x xs ->+ SG.getMax (NN.ofoldMap1 SG.Max $ nconsAs x xs du) @?= Prelude.maximum (x:xs)+ prop "ofoldr1" $ \x xs ->+ NN.ofoldr1 Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs)+ prop "ofoldl1'" $ \x xs ->+ NN.ofoldl1' Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs)++ test "Strict ByteString" S.empty+ test "Lazy ByteString" L.empty+ test "Strict Text" T.empty+ test "Lazy Text" TL.empty+ test "Vector" (V.empty :: V.Vector Int)+ test "Unboxed Vector" (U.empty :: U.Vector Int)+ test "Storable Vector" (VS.empty :: VS.Vector Int)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (VSC.empty :: VSC.Vector Int)+#endif+ test "List" ([5 :: Int])++ describe "Containers" $ do+ let test typ dummy xlookup xinsert xdelete = describe typ $ do+ prop "difference" $ \(DuplPairs xs) (DuplPairs ys) ->+ let m1 = mapFromList xs `difference` mapFromList ys+ m2 = mapFromListAs (xs `difference` ys) dummy+ in m1 @?= m2++ prop "lookup" $ \(DuplPairs xs) -> indexIn xs $ \k ->+ let m = mapFromListAs xs dummy+ v1 = lookup k m+ in do+ v1 @?= lookup k xs+ v1 @?= xlookup k m++ prop "insert" $ \(DuplPairs xs) v -> indexIn xs $ \k ->+ let m = mapFromListAs xs dummy+ m1 = insertMap k v m+ in do+ m1 @?= mapFromList (insertMap k v xs)+ m1 @?= xinsert k v m++ prop "delete" $ \(DuplPairs xs) -> indexIn xs $ \k ->+ let m = mapFromListAs xs dummy+ m1 = deleteMap k m+ in do+ m1 @?= mapFromList (deleteMap k xs)+ m1 @?= xdelete k m++ prop "singletonMap" $ \k v ->+ singletonMap k v @?= (mapFromListAs [(k, v)] dummy)++ prop "findWithDefault" $ \(DuplPairs xs) k v ->+ findWithDefault v k (mapFromListAs xs dummy)+ @?= findWithDefault v k xs++ prop "insertWith" $ \(DuplPairs xs) k v ->+ insertWith (+) k v (mapFromListAs xs dummy)+ @?= mapFromList (insertWith (+) k v xs)++ prop "insertWithKey" $ \(DuplPairs xs) k v ->+ let m = mapFromListAs xs dummy+ f x y z = x + y + z+ in insertWithKey f k v m+ @?= mapFromList (insertWithKey f k v xs)++ prop "insertLookupWithKey" $ \(DuplPairs xs) k v ->+ let m = mapFromListAs xs dummy+ f x y z = x + y + z+ in insertLookupWithKey f k v m @?=+ second mapFromList (insertLookupWithKey f k v xs)++ prop "adjustMap" $ \(DuplPairs xs) k ->+ adjustMap succ k (mapFromListAs xs dummy)+ @?= mapFromList (adjustMap succ k xs)++ prop "adjustWithKey" $ \(DuplPairs xs) k ->+ adjustWithKey (+) k (mapFromListAs xs dummy)+ @?= mapFromList (adjustWithKey (+) k xs)++ prop "updateMap" $ \(DuplPairs xs) k ->+ let f i = if i < 0 then Nothing else Just $ i * 2+ in updateMap f k (mapFromListAs xs dummy)+ @?= mapFromList (updateMap f k xs)++ prop "updateWithKey" $ \(DuplPairs xs) k' ->+ let f k i = if i < 0 then Nothing else Just $ i * k+ in updateWithKey f k' (mapFromListAs xs dummy)+ @?= mapFromList (updateWithKey f k' xs)++ prop "updateLookupWithKey" $ \(DuplPairs xs) k' ->+ let f k i = if i < 0 then Nothing else Just $ i * k+ in updateLookupWithKey f k' (mapFromListAs xs dummy)+ @?= second mapFromList (updateLookupWithKey f k' xs)++ prop "alter" $ \(DuplPairs xs) k ->+ let m = mapFromListAs xs dummy+ f Nothing = Just (-1)+ f (Just i) = if i < 0 then Nothing else Just (i * 2)+ in lookup k (alterMap f k m) @?= f (lookup k m)++ prop "unionWith" $ \(DuplPairs xs) (DuplPairs ys) ->+ let m1 = unionWith (+)+ (mapFromListAs xs dummy)+ (mapFromListAs ys dummy)+ m2 = mapFromList (unionWith (+) xs ys)+ in m1 @?= m2++ prop "unionWithKey" $ \(DuplPairs xs) (DuplPairs ys) ->+ let f k x y = k + x + y+ m1 = unionWithKey f+ (mapFromListAs xs dummy)+ (mapFromListAs ys dummy)+ m2 = mapFromList (unionWithKey f xs ys)+ in m1 @?= m2++ prop "unionsWith" $ \(SmallList xss) ->+ let duplXss = map unDupl xss+ ms = map mapFromList duplXss `asTypeOf` [dummy]+ in unionsWith (+) ms+ @?= mapFromList (unionsWith (+) duplXss)++ prop "mapWithKey" $ \(DuplPairs xs) ->+ let m1 = mapWithKey (+) (mapFromList xs) `asTypeOf` dummy+ m2 = mapFromList $ mapWithKey (+) xs+ in m1 @?= m2++ prop "omapKeysWith" $ \(DuplPairs xs) ->+ let f = flip mod 5+ m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy+ m2 = mapFromList $ omapKeysWith (+) f xs+ in m1 @?= m2++ test "Data.Map" (Map.empty :: Map.Map Int Int)+ Map.lookup Map.insert Map.delete+ test "Data.IntMap" (IntMap.empty :: IntMap.IntMap Int)+ IntMap.lookup IntMap.insert IntMap.delete+ test "Data.HashMap" (HashMap.empty :: HashMap.HashMap Int Int)+ HashMap.lookup HashMap.insert HashMap.delete++ describe "Foldl Integration" $ do+ prop "vector" $ \xs -> do+#if MIN_VERSION_foldl(1,3,0)+ let x1 = Foldl.fold Foldl.vector (xs :: [Int])+ x2 = Foldl.purely ofoldlUnwrap Foldl.vector xs+#else+ x1 <- Foldl.foldM Foldl.vector (xs :: [Int])+ x2 <- Foldl.impurely ofoldMUnwrap Foldl.vector xs+#endif+ x2 @?= (x1 :: V.Vector Int)+ prop "length" $ \xs -> do+ let x1 = Foldl.fold Foldl.length (xs :: [Int])+ x2 = Foldl.purely ofoldlUnwrap Foldl.length xs+ x2 @?= x1++ describe "Replacing" $ do+ let test typ dummy = describe typ $ do+ prop "replaceElem old new === omap (\\x -> if x == old then new else x)" $+ -- replace random element or any random value with random new value+ \x list new -> forAll (elements (x:list)) $ \old ->+ let seq' = fromListAs list dummy+ in replaceElem old new seq' @?= omap (\x' -> if x' == old then new else x') seq'+#if MIN_VERSION_QuickCheck(2,8,0)+ prop "replaceSeq old new === ointercalate new . splitSeq old" $+ -- replace random subsequence with random new sequence+ \list new -> forAll (sublistOf list) $ \old ->+ let [seq', old', new'] = map (`fromListAs` dummy) [list, old, new]+ in replaceSeq old' new' seq' @?= ointercalate new' (splitSeq old' seq')+ prop "replaceSeq old old === id" $ \list -> forAll (sublistOf list) $ \old ->+ let [seq', old'] = map (`fromListAs` dummy) [list, old]+ in replaceSeq old' old' seq' @?= seq'+#endif+ test "List" ([] :: [Int])+ test "Vector" (V.empty :: V.Vector Int)+ test "Storable Vector" (VS.empty :: VS.Vector Int)+ test "Unboxed Vector" (U.empty :: U.Vector Int)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (VSC.empty :: VSC.Vector Int)+#endif+ test "Strict ByteString" S.empty+ test "Lazy ByteString" L.empty+ test "Strict Text" T.empty+ test "Lazy Text" TL.empty++ describe "Sorting" $ do+ let test typ dummy = describe typ $ do+ prop "sortBy" $ \input -> do+ let f x y = compare y x+ fromList (sortBy f input) @?= sortBy f (fromListAs input dummy)+ prop "sort" $ \input ->+ fromList (sort input) @?= sort (fromListAs input dummy)+ test "List" ([] :: [Int])+ test "Vector" (V.empty :: V.Vector Int)+ test "Storable Vector" (VS.empty :: VS.Vector Int)+ test "Unboxed Vector" (U.empty :: U.Vector Int)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (VSC.empty :: VSC.Vector Int)+#endif+ test "Strict ByteString" S.empty+ test "Lazy ByteString" L.empty+ test "Strict Text" T.empty+ test "Lazy Text" TL.empty++ describe "Intercalate" $ do+ let test typ dummy = describe typ $ do+ prop "intercalate === defaultIntercalate" $ \list lists ->+ let seq' = fromListAs list dummy+ seqs = map (`fromListAs` dummy) lists+ in ointercalate seq' seqs @?= fromList (List.intercalate list lists)+ test "List" ([] :: [Int])+ test "Vector" (V.empty :: V.Vector Int)+ test "Storable Vector" (VS.empty :: VS.Vector Int)+ test "Unboxed Vector" (U.empty :: U.Vector Int)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (VSC.empty :: VSC.Vector Int)+#endif+ test "Strict ByteString" S.empty+ test "Lazy ByteString" L.empty+ test "Strict Text" T.empty+ test "Lazy Text" TL.empty++ describe "Splitting" $ do+ let test typ dummy = describe typ $ do+ let fromList' = (`fromListAs` dummy)+ let fromSepList sep = fromList' . map (fromMaybe sep)+ prop "intercalate sep . splitSeq sep === id" $+ \(fromList' -> sep) ->+ \(mconcat . map (maybe sep fromList') -> xs) ->+ ointercalate sep (splitSeq sep xs) @?= xs+ prop "splitSeq mempty xs === mempty : map singleton (otoList xs)" $+ \input ->+ splitSeq mempty (fromList' input) @?= mempty : map singleton input+ prop "splitSeq _ mempty == [mempty]" $+ \(fromList' -> sep) ->+ splitSeq sep mempty @?= [mempty]+ prop "intercalate (singleton sep) . splitElem sep === id" $+ \sep -> \(fromSepList sep -> xs) ->+ ointercalate (singleton sep) (splitElem sep xs) @?= xs+ prop "length . splitElem sep === succ . length . filter (== sep)" $+ \sep -> \(fromSepList sep -> xs) ->+ olength (splitElem sep xs) @?= olength (filter (== sep) xs) + 1+ prop "splitElem sep (replicate n sep) == replicate (n+1) mempty" $+ \(NonNegative n) sep ->+ splitElem sep (fromList' (replicate n sep)) @?= replicate (n + 1) mempty+ prop "splitElem sep === splitWhen (== sep)" $+ \sep -> \(fromSepList sep -> xs) ->+ splitElem sep xs @?= splitWhen (== sep) xs+ prop "splitElem sep === splitSeq (singleton sep)" $+ \sep -> \(fromSepList sep -> xs) ->+ splitElem sep xs @?= splitSeq (singleton sep) xs+ test "List" ([] :: [Int])+ test "Vector" (V.empty :: V.Vector Int)+ test "Storable Vector" (VS.empty :: VS.Vector Int)+ test "Unboxed Vector" (U.empty :: U.Vector Int)+#if MIN_VERSION_vector(0,13,2)+ test "Strict Vector" (VSC.empty :: VSC.Vector Int)+#endif+ test "Strict ByteString" S.empty+ test "Lazy ByteString" L.empty+ test "Strict Text" T.empty+ test "Lazy Text" TL.empty++ describe "Other Issues" $ do+ it "#26 headEx on a list works" $+ headEx (1 : filter Prelude.odd [2,4..]) @?= (1 :: Int)++ it "#31 find doesn't infinitely loop on NonEmpty" $+ find (== "a") ("a" NE.:| ["d","fgf"]) @?= Just ("a" :: String)++ it "#83 head on Seq works correctly" $ do+ headEx (Seq.fromList [1 :: Int,2,3]) @?= (1 :: Int)+ headMay (Seq.fromList [] :: Seq.Seq Int) @?= Nothing
− test/Spec.hs
@@ -1,482 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE CPP #-}--module Spec where--import Data.MonoTraversable-import Data.Containers-import Data.Sequences-import qualified Data.Sequence as Seq-import qualified Data.NonNull as NN-import Data.Monoid (mempty, mconcat)-import Data.Maybe (fromMaybe)-import qualified Data.List as List--import Test.Hspec-import Test.Hspec.QuickCheck-import Test.HUnit ((@?=))-import Test.QuickCheck hiding (NonEmptyList(..))-import qualified Test.QuickCheck.Modifiers as QCM--import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Storable as VS-import qualified Data.List.NonEmpty as NE-import qualified Data.Semigroup as SG-import qualified Data.Map as Map-import qualified Data.IntMap as IntMap-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Set as Set-import qualified Control.Foldl as Foldl--import Control.Arrow (second)-import Control.Applicative-import Control.Monad.Trans.Writer--import Prelude (Bool (..), ($), IO, Eq (..), fromIntegral, Ord (..), String, mod, Int, Integer, show,- return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe)-import qualified Prelude--newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a)- deriving (Show, Eq)-instance Arbitrary a => Arbitrary (NonEmpty' a) where- arbitrary = NonEmpty' <$> ((NE.:|) <$> arbitrary <*> arbitrary)---- | Arbitrary newtype for key-value pairs without any duplicate keys--- and is not empty-newtype DuplPairs k v = DuplPairs { unDupl :: [(k,v)] }- deriving (Eq, Show)--removeDuplicateKeys :: Ord k => [(k,v)] -> [(k,v)]-removeDuplicateKeys m = go Set.empty m- where go _ [] = []- go used ((k,v):xs)- | k `member` used = go used xs- | otherwise = (k,v) : go (insertSet k used) xs--instance (Arbitrary k, Arbitrary v, Ord k, Eq v) => Arbitrary (DuplPairs k v) where- arbitrary = DuplPairs . removeDuplicateKeys <$> arbitrary `suchThat` (/= [])- shrink (DuplPairs xs) =- map (DuplPairs . removeDuplicateKeys) $ filter (/= []) $ shrink xs---- | Arbitrary newtype for small lists whose length is <= 10------ Used for testing 'unionsWith'-newtype SmallList a = SmallList { getSmallList :: [a] }- deriving (Eq, Show, Ord)--instance (Arbitrary a) => Arbitrary (SmallList a) where- arbitrary = SmallList <$> arbitrary `suchThat` ((<= 10) . olength)- shrink (SmallList xs) =- map SmallList $ filter ((<= 10) . olength) $ shrink xs---- | Choose a random key from a key-value pair list-indexIn :: (Show k, Testable prop) => [(k,v)] -> (k -> prop) -> Property-indexIn = forAll . elements . map Prelude.fst---- | Type restricted 'fromList'-fromListAs :: IsSequence a => [Element a] -> a -> a-fromListAs xs _ = fromList xs---- | Type restricted 'mapFromListAs'-mapFromListAs :: IsMap a => [(ContainerKey a, MapValue a)] -> a -> a-mapFromListAs xs _ = mapFromList xs--main :: IO ()-main = hspec $ do- describe "onull" $ do- it "works on empty lists" $ onull [] @?= True- it "works on non-empty lists" $ onull [()] @?= False- it "works on empty texts" $ onull ("" :: Text) @?= True- it "works on non-empty texts" $ onull ("foo" :: Text) @?= False-- describe "osum" $ do- prop "works on lists" $ \(Small x) (Small y) ->- y >= x ==> osum [x..y] @?= ((x + y) * (y - x + 1) `div` (2 :: Int))-- describe "oproduct" $ do- prop "works on lists" $ \(Positive x) (Positive y) ->- let fact n = oproduct [1..n]- in (y :: Integer) > (x :: Integer) ==>- oproduct [x..y] @?= fact y `div` fact (x - 1)-- describe "olength" $ do- prop "works on lists" $ \(NonNegative i) ->- olength (replicate i () :: [()]) @?= i- prop "works on texts" $ \(NonNegative i) ->- olength (replicate i 'a' :: Text) @?= i- prop "works on lazy bytestrings" $ \(NonNegative (Small i)) ->- olength64 (replicate i 6 :: L.ByteString) @?= i-- describe "omap" $ do- prop "works on lists" $ \xs ->- omap (+1) xs @?= map (+1) (xs :: [Int])- prop "works on lazy bytestrings" $ \xs ->- omap (+1) (fromList xs :: L.ByteString) @?= fromList (map (+1) xs)- prop "works on texts" $ \xs ->- omap succ (fromList xs :: Text) @?= fromList (map succ xs)-- describe "oconcatMap" $ do- prop "works on lists" $ \xs ->- oconcatMap (: []) xs @?= (xs :: [Int])-- describe "ocompareLength" $ do- prop "works on lists" $ \(Positive i) j ->- ocompareLength (replicate i () :: [()]) j @?= compare i j-- describe "groupAll" $ do- it "works on lists" $ groupAll ("abcabcabc" :: String) @?= ["aaa", "bbb", "ccc"]- it "works on texts" $ groupAll ("abcabcabc" :: Text) @?= ["aaa", "bbb", "ccc"]-- describe "unsnoc" $ do- let test name dummy = prop name $ \(QCM.NonEmpty xs) ->- let seq' = fromListAs xs dummy- in case unsnoc seq' of- Just (y, z) -> do- y SG.<> singleton z @?= seq'- snoc y z @?= seq'- otoList (snoc y z) @?= xs- Nothing -> expectationFailure "unsnoc returned Nothing"- test "works on lists" ([] :: [Int])- test "works on texts" ("" :: Text)- test "works on lazy bytestrings" L.empty-- describe "index" $ do- let test name dummy = prop name $- \(NonNegative i') (QCM.NonEmpty xs) ->- let seq' = fromListAs xs dummy- mx = index xs (fromIntegral i)- i = fromIntegral (i' :: Int)- in do- mx @?= index seq' i- case mx of- Nothing -> return ()- Just x -> indexEx seq' i @?= x- test "works on lists" ([] :: [Int])- test "works on strict texts" ("" :: Text)- test "works on lazy texts" ("" :: TL.Text)- test "works on strict bytestrings" S.empty- test "works on lazy bytestrings" L.empty- test "works on Vector" (V.singleton (1 :: Int))- test "works on SVector" (VS.singleton (1 :: Int))- test "works on UVector" (U.singleton (1 :: Int))- test "works on Seq" (Seq.fromList [1 :: Int])-- describe "groupAllOn" $ do- it "works on lists" $- groupAllOn (`mod` 3) ([1..9] :: [Int]) @?= [[1, 4, 7], [2, 5, 8], [3, 6, 9]]-- describe "breakWord" $ do- let test x y z = it (show (x, y, z)) $ breakWord (x :: Text) @?= (y, z)- test "hello world" "hello" "world"- test "hello world" "hello" "world"- test "hello\r\nworld" "hello" "world"- test "hello there world" "hello" "there world"- test "" "" ""- test "hello \n\r\t" "hello" ""-- describe "breakLine" $ do- let test x y z = it (show (x, y, z)) $ breakLine (x :: Text) @?= (y, z)- test "hello world" "hello world" ""- test "hello\r\n world" "hello" " world"- test "hello\n world" "hello" " world"- test "hello\r world" "hello\r world" ""- test "hello\r\nworld" "hello" "world"- test "hello\r\nthere\nworld" "hello" "there\nworld"- test "hello\n\r\nworld" "hello" "\r\nworld"- test "" "" ""-- describe "omapM_" $ do- let test typ dummy = prop typ $ \input ->- input @?= execWriter (omapM_ (tell . return) (fromListAs input dummy))- test "works on strict bytestrings" S.empty- test "works on lazy bytestrings" L.empty- test "works on strict texts" T.empty- test "works on lazy texts" TL.empty-- describe "NonNull" $ do- describe "fromNonEmpty" $ do- prop "toMinList" $ \(NonEmpty' ne) ->- (NE.toList ne :: [Int]) @?= NN.toNullable (NN.toMinList ne)-- let -- | Type restricted 'NN.ncons'- nconsAs :: IsSequence seq => Element seq -> [Element seq] -> seq -> NN.NonNull seq- nconsAs x xs _ = NN.ncons x (fromList xs)-- test :: (IsSequence typ, Ord (Element typ), Arbitrary (Element typ), Show (Element typ), Show typ, Eq typ, Eq (Element typ))- => String -> typ -> Spec- test typ du = describe typ $ do- prop "head" $ \x xs ->- NN.head (nconsAs x xs du) @?= x- prop "tail" $ \x xs ->- NN.tail (nconsAs x xs du) @?= fromList xs- prop "last" $ \x xs ->- NN.last (reverse $ nconsAs x xs du) @?= x- prop "init" $ \x xs ->- NN.init (reverse $ nconsAs x xs du) @?= reverse (fromList xs)- prop "maximum" $ \x xs ->- NN.maximum (nconsAs x xs du) @?= Prelude.maximum (x:xs)- prop "maximumBy" $ \x xs ->- NN.maximumBy compare (nconsAs x xs du) @?= Prelude.maximum (x:xs)- prop "minimum" $ \x xs ->- NN.minimum (nconsAs x xs du) @?= Prelude.minimum (x:xs)- prop "minimumBy" $ \x xs ->- NN.minimumBy compare (nconsAs x xs du) @?= Prelude.minimum (x:xs)- prop "ofoldMap1" $ \x xs ->- SG.getMax (NN.ofoldMap1 SG.Max $ nconsAs x xs du) @?= Prelude.maximum (x:xs)- prop "ofoldr1" $ \x xs ->- NN.ofoldr1 Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs)- prop "ofoldl1'" $ \x xs ->- NN.ofoldl1' Prelude.min (nconsAs x xs du) @?= Prelude.minimum (x:xs)-- test "Strict ByteString" S.empty- test "Lazy ByteString" L.empty- test "Strict Text" T.empty- test "Lazy Text" TL.empty- test "Vector" (V.empty :: V.Vector Int)- test "Unboxed Vector" (U.empty :: U.Vector Int)- test "Storable Vector" (VS.empty :: VS.Vector Int)- test "List" ([5 :: Int])-- describe "Containers" $ do- let test typ dummy xlookup xinsert xdelete = describe typ $ do- prop "difference" $ \(DuplPairs xs) (DuplPairs ys) ->- let m1 = mapFromList xs `difference` mapFromList ys- m2 = mapFromListAs (xs `difference` ys) dummy- in m1 @?= m2-- prop "lookup" $ \(DuplPairs xs) -> indexIn xs $ \k ->- let m = mapFromListAs xs dummy- v1 = lookup k m- in do- v1 @?= lookup k xs- v1 @?= xlookup k m-- prop "insert" $ \(DuplPairs xs) v -> indexIn xs $ \k ->- let m = mapFromListAs xs dummy- m1 = insertMap k v m- in do- m1 @?= mapFromList (insertMap k v xs)- m1 @?= xinsert k v m-- prop "delete" $ \(DuplPairs xs) -> indexIn xs $ \k ->- let m = mapFromListAs xs dummy- m1 = deleteMap k m- in do- m1 @?= mapFromList (deleteMap k xs)- m1 @?= xdelete k m-- prop "singletonMap" $ \k v ->- singletonMap k v @?= (mapFromListAs [(k, v)] dummy)-- prop "findWithDefault" $ \(DuplPairs xs) k v ->- findWithDefault v k (mapFromListAs xs dummy)- @?= findWithDefault v k xs-- prop "insertWith" $ \(DuplPairs xs) k v ->- insertWith (+) k v (mapFromListAs xs dummy)- @?= mapFromList (insertWith (+) k v xs)-- prop "insertWithKey" $ \(DuplPairs xs) k v ->- let m = mapFromListAs xs dummy- f x y z = x + y + z- in insertWithKey f k v m- @?= mapFromList (insertWithKey f k v xs)-- prop "insertLookupWithKey" $ \(DuplPairs xs) k v ->- let m = mapFromListAs xs dummy- f x y z = x + y + z- in insertLookupWithKey f k v m @?=- second mapFromList (insertLookupWithKey f k v xs)-- prop "adjustMap" $ \(DuplPairs xs) k ->- adjustMap succ k (mapFromListAs xs dummy)- @?= mapFromList (adjustMap succ k xs)-- prop "adjustWithKey" $ \(DuplPairs xs) k ->- adjustWithKey (+) k (mapFromListAs xs dummy)- @?= mapFromList (adjustWithKey (+) k xs)-- prop "updateMap" $ \(DuplPairs xs) k ->- let f i = if i < 0 then Nothing else Just $ i * 2- in updateMap f k (mapFromListAs xs dummy)- @?= mapFromList (updateMap f k xs)-- prop "updateWithKey" $ \(DuplPairs xs) k' ->- let f k i = if i < 0 then Nothing else Just $ i * k- in updateWithKey f k' (mapFromListAs xs dummy)- @?= mapFromList (updateWithKey f k' xs)-- prop "updateLookupWithKey" $ \(DuplPairs xs) k' ->- let f k i = if i < 0 then Nothing else Just $ i * k- in updateLookupWithKey f k' (mapFromListAs xs dummy)- @?= second mapFromList (updateLookupWithKey f k' xs)-- prop "alter" $ \(DuplPairs xs) k ->- let m = mapFromListAs xs dummy- f Nothing = Just (-1)- f (Just i) = if i < 0 then Nothing else Just (i * 2)- in lookup k (alterMap f k m) @?= f (lookup k m)-- prop "unionWith" $ \(DuplPairs xs) (DuplPairs ys) ->- let m1 = unionWith (+)- (mapFromListAs xs dummy)- (mapFromListAs ys dummy)- m2 = mapFromList (unionWith (+) xs ys)- in m1 @?= m2-- prop "unionWithKey" $ \(DuplPairs xs) (DuplPairs ys) ->- let f k x y = k + x + y- m1 = unionWithKey f- (mapFromListAs xs dummy)- (mapFromListAs ys dummy)- m2 = mapFromList (unionWithKey f xs ys)- in m1 @?= m2-- prop "unionsWith" $ \(SmallList xss) ->- let duplXss = map unDupl xss- ms = map mapFromList duplXss `asTypeOf` [dummy]- in unionsWith (+) ms- @?= mapFromList (unionsWith (+) duplXss)-- prop "mapWithKey" $ \(DuplPairs xs) ->- let m1 = mapWithKey (+) (mapFromList xs) `asTypeOf` dummy- m2 = mapFromList $ mapWithKey (+) xs- in m1 @?= m2-- prop "omapKeysWith" $ \(DuplPairs xs) ->- let f = flip mod 5- m1 = omapKeysWith (+) f (mapFromList xs) `asTypeOf` dummy- m2 = mapFromList $ omapKeysWith (+) f xs- in m1 @?= m2-- test "Data.Map" (Map.empty :: Map.Map Int Int)- Map.lookup Map.insert Map.delete- test "Data.IntMap" (IntMap.empty :: IntMap.IntMap Int)- IntMap.lookup IntMap.insert IntMap.delete- test "Data.HashMap" (HashMap.empty :: HashMap.HashMap Int Int)- HashMap.lookup HashMap.insert HashMap.delete-- describe "Foldl Integration" $ do- prop "vector" $ \xs -> do- x1 <- Foldl.foldM Foldl.vector (xs :: [Int])- x2 <- Foldl.impurely ofoldMUnwrap Foldl.vector xs- x2 @?= (x1 :: V.Vector Int)- prop "length" $ \xs -> do- let x1 = Foldl.fold Foldl.length (xs :: [Int])- x2 = Foldl.purely ofoldlUnwrap Foldl.length xs- x2 @?= x1-- describe "Replacing" $ do- let test typ dummy = describe typ $ do- prop "replaceElem old new === omap (\\x -> if x == old then new else x)" $- -- replace random element or any random value with random new value- \x list new -> forAll (elements (x:list)) $ \old ->- let seq' = fromListAs list dummy- in replaceElem old new seq' @?= omap (\x -> if x == old then new else x) seq'-#if MIN_VERSION_QuickCheck(2,8,0)- prop "replaceSeq old new === ointercalate new . splitSeq old" $- -- replace random subsequence with random new sequence- \list new -> forAll (sublistOf list) $ \old ->- let [seq', old', new'] = map (`fromListAs` dummy) [list, old, new]- in replaceSeq old' new' seq' @?= ointercalate new' (splitSeq old' seq')- prop "replaceSeq old old === id" $ \list -> forAll (sublistOf list) $ \old ->- let [seq', old'] = map (`fromListAs` dummy) [list, old]- in replaceSeq old' old' seq' @?= seq'-#endif- test "List" ([] :: [Int])- test "Vector" (V.empty :: V.Vector Int)- test "Storable Vector" (VS.empty :: VS.Vector Int)- test "Unboxed Vector" (U.empty :: U.Vector Int)- test "Strict ByteString" S.empty- test "Lazy ByteString" L.empty- test "Strict Text" T.empty- test "Lazy Text" TL.empty-- describe "Sorting" $ do- let test typ dummy = describe typ $ do- prop "sortBy" $ \input -> do- let f x y = compare y x- fromList (sortBy f input) @?= sortBy f (fromListAs input dummy)- prop "sort" $ \input ->- fromList (sort input) @?= sort (fromListAs input dummy)- test "List" ([] :: [Int])- test "Vector" (V.empty :: V.Vector Int)- test "Storable Vector" (VS.empty :: VS.Vector Int)- test "Unboxed Vector" (U.empty :: U.Vector Int)- test "Strict ByteString" S.empty- test "Lazy ByteString" L.empty- test "Strict Text" T.empty- test "Lazy Text" TL.empty-- describe "Intercalate" $ do- let test typ dummy = describe typ $ do- prop "intercalate === defaultIntercalate" $ \list lists ->- let seq' = fromListAs list dummy- seqs = map (`fromListAs` dummy) lists- in ointercalate seq' seqs @?= fromList (List.intercalate list lists)- test "List" ([] :: [Int])- test "Vector" (V.empty :: V.Vector Int)- test "Storable Vector" (VS.empty :: VS.Vector Int)- test "Unboxed Vector" (U.empty :: U.Vector Int)- test "Strict ByteString" S.empty- test "Lazy ByteString" L.empty- test "Strict Text" T.empty- test "Lazy Text" TL.empty-- describe "Splitting" $ do- let test typ dummy = describe typ $ do- let fromList' = (`fromListAs` dummy)- let fromSepList sep = fromList' . map (fromMaybe sep)- prop "intercalate sep . splitSeq sep === id" $- \(fromList' -> sep) ->- \(mconcat . map (maybe sep fromList') -> xs) ->- ointercalate sep (splitSeq sep xs) @?= xs- prop "splitSeq mempty xs === mempty : map singleton (otoList xs)" $- \input ->- splitSeq mempty (fromList' input) @?= mempty : map singleton input- prop "splitSeq _ mempty == [mempty]" $- \(fromList' -> sep) ->- splitSeq sep mempty @?= [mempty]- prop "intercalate (singleton sep) . splitElem sep === id" $- \sep -> \(fromSepList sep -> xs) ->- ointercalate (singleton sep) (splitElem sep xs) @?= xs- prop "length . splitElem sep === succ . length . filter (== sep)" $- \sep -> \(fromSepList sep -> xs) ->- olength (splitElem sep xs) @?= olength (filter (== sep) xs) + 1- prop "splitElem sep (replicate n sep) == replicate (n+1) mempty" $- \(NonNegative n) sep ->- splitElem sep (fromList' (replicate n sep)) @?= replicate (n + 1) mempty- prop "splitElem sep === splitWhen (== sep)" $- \sep -> \(fromSepList sep -> xs) ->- splitElem sep xs @?= splitWhen (== sep) xs- prop "splitElem sep === splitSeq (singleton sep)" $- \sep -> \(fromSepList sep -> xs) ->- splitElem sep xs @?= splitSeq (singleton sep) xs- test "List" ([] :: [Int])- test "Vector" (V.empty :: V.Vector Int)- test "Storable Vector" (VS.empty :: VS.Vector Int)- test "Unboxed Vector" (U.empty :: U.Vector Int)- test "Strict ByteString" S.empty- test "Lazy ByteString" L.empty- test "Strict Text" T.empty- test "Lazy Text" TL.empty-- describe "Other Issues" $ do- it "#26 headEx on a list works" $- headEx (1 : filter Prelude.odd [2,4..]) @?= (1 :: Int)-- it "#31 find doesn't infinitely loop on NonEmpty" $- find (== "a") ("a" NE.:| ["d","fgf"]) @?= Just ("a" :: String)-- it "#83 head on Seq works correctly" $ do- headEx (Seq.fromList [1 :: Int,2,3]) @?= (1 :: Int)- headMay (Seq.fromList [] :: Seq.Seq Int) @?= Nothing
− test/main.hs
@@ -1,1 +0,0 @@-import Spec (main)