mono-traversable 1.0.15.3 → 1.0.21.0
raw patch · 12 files changed
Files
- ChangeLog.md +35/−1
- bench/InitTails.hs +89/−0
- bench/Sorting.hs +43/−0
- bench/main.hs +17/−0
- bench/sorting.hs +0/−39
- mono-traversable.cabal +15/−5
- src/Data/Containers.hs +16/−3
- src/Data/MonoTraversable.hs +90/−2
- src/Data/MonoTraversable/Unprefixed.hs +1/−0
- src/Data/NonNull.hs +2/−2
- src/Data/Sequences.hs +149/−4
- test/Main.hs +109/−2
ChangeLog.md view
@@ -1,5 +1,39 @@ # 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`)@@ -173,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
+ 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,39 +0,0 @@-{-# LANGUAGE CPP #-}--#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--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,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: mono-traversable-version: 1.0.15.3+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@@ -57,6 +57,8 @@ hs-source-dirs: test ghc-options: -O0+ build-tool-depends:+ hspec-discover:hspec-discover build-depends: HUnit , QuickCheck@@ -72,18 +74,26 @@ , vector default-language: Haskell2010 -benchmark sorting+benchmark all type: exitcode-stdio-1.0- main-is: sorting.hs+ main-is: main.hs other-modules:+ InitTails+ Sorting Paths_mono_traversable hs-source-dirs: bench- ghc-options: -Wall -O2+ 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,7 +4,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-}--- | Warning: This module should be considered highly experimental.+{-# LANGUAGE TypeOperators #-} module Data.Containers where import Prelude hiding (lookup)@@ -547,9 +547,16 @@ -- | Filter values in a map. -- -- @since 1.0.9.0- filterMap :: IsMap map => (MapValue map -> Bool) -> map -> map- filterMap p = mapFromList . filter (p . snd) . mapToList+ 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". instance Ord key => IsMap (Map.Map key value) where type MapValue (Map.Map key value) = value@@ -598,6 +605,8 @@ {-# INLINE omapKeysWith #-} filterMap = Map.filter {-# INLINE filterMap #-}+ filterWithKey = Map.filterWithKey+ {-# INLINE filterWithKey #-} -- | This instance uses the functions from "Data.HashMap.Strict". instance (Eq key, Hashable key) => IsMap (HashMap.HashMap key value) where@@ -635,6 +644,8 @@ --mapKeysWith = HashMap.mapKeysWith filterMap = HashMap.filter {-# INLINE filterMap #-}+ filterWithKey = HashMap.filterWithKey+ {-# INLINE filterWithKey #-} -- | This instance uses the functions from "Data.IntMap.Strict". instance IsMap (IntMap.IntMap value) where@@ -683,6 +694,8 @@ {-# INLINE omapKeysWith #-} filterMap = IntMap.filter {-# INLINE filterMap #-}+ filterWithKey = IntMap.filterWithKey+ {-# INLINE filterWithKey #-} instance Eq key => IsMap [(key, value)] where type MapValue [(key, value)] = value
src/Data/MonoTraversable.hs view
@@ -33,13 +33,15 @@ import Control.Monad (Monad (..)) 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)@@ -54,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 (..))@@ -63,6 +66,7 @@ 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)@@ -89,6 +93,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 qualified Data.IntSet as IntSet import Data.Semigroup ( Semigroup@@ -106,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@@ -151,6 +164,10 @@ 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@@ -162,6 +179,7 @@ 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@@ -249,6 +267,13 @@ 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@. --@@ -426,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@@ -753,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@@ -817,6 +875,13 @@ 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'. --@@ -1042,6 +1107,10 @@ omapM = otraverse {-# 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)@@ -1080,6 +1149,9 @@ 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@@ -1140,12 +1212,20 @@ 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]@@ -1198,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 #-}@@ -1308,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
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
src/Data/NonNull.hs view
@@ -145,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
src/Data/Sequences.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-}@@ -5,6 +6,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE TypeOperators #-} -- | Abstractions over sequential data structures, like lists and vectors. module Data.Sequences where @@ -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.@@ -151,7 +158,7 @@ lengthIndex :: seq -> Index seq; lengthIndex = fromIntegral . olength64; - -- below functions change type fron the perspective of NonEmpty+ -- 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@@ -423,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)@@ -472,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 #-}@@ -502,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)@@ -607,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 #-}@@ -625,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@@ -961,6 +1022,12 @@ {-# 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@@ -1034,6 +1101,84 @@ {-# 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 @@ -1477,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
@@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-}@@ -13,7 +14,7 @@ import Data.Sequences import qualified Data.Sequence as Seq import qualified Data.NonNull as NN-import Data.Monoid (mempty, mconcat)+import Data.Monoid (mempty, mconcat, (<>)) import Data.Maybe (fromMaybe) import qualified Data.List as List @@ -32,6 +33,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+{-# 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@@ -39,13 +45,14 @@ 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)+ return, asTypeOf, (.), Show, (+), succ, Maybe (..), (*), mod, map, flip, otherwise, (-), div, maybe, Char) import qualified Prelude newtype NonEmpty' a = NonEmpty' (NE.NonEmpty a)@@ -93,6 +100,13 @@ 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@@ -135,6 +149,27 @@ 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"]@@ -170,6 +205,9 @@ 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]) @@ -205,6 +243,60 @@ 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) ->@@ -259,6 +351,9 @@ 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@@ -416,6 +511,9 @@ 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@@ -432,6 +530,9 @@ 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@@ -447,6 +548,9 @@ 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@@ -485,6 +589,9 @@ 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