mono-traversable 1.0.15.3 → 1.0.17.0
raw patch · 10 files changed
+301/−54 lines, 10 filesdep +deepseqdep ~bytestringdep ~containersdep ~text
Dependencies added: deepseq
Dependency ranges changed: bytestring, containers, text
Files
- ChangeLog.md +12/−1
- bench/InitTails.hs +89/−0
- bench/Sorting.hs +43/−0
- bench/main.hs +17/−0
- bench/sorting.hs +0/−39
- mono-traversable.cabal +13/−5
- src/Data/MonoTraversable.hs +8/−1
- src/Data/NonNull.hs +2/−2
- src/Data/Sequences.hs +64/−4
- test/Main.hs +53/−2
ChangeLog.md view
@@ -1,5 +1,16 @@ # ChangeLog for mono-traversable +## 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 +184,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.36.0. -- -- see: https://github.com/sol/hpack name: mono-traversable-version: 1.0.15.3+version: 1.0.17.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@@ -72,18 +72,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/MonoTraversable.hs view
@@ -33,6 +33,7 @@ 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)@@ -106,6 +107,8 @@ 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 type instance Element [a] = a@@ -426,7 +429,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@@ -1139,6 +1142,10 @@ {-# INLINE opoint #-} 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
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
@@ -42,7 +42,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 +151,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 +423,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 +472,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 +543,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 +651,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 +676,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 +1015,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@@ -1477,7 +1537,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 @@ -39,13 +40,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 +95,10 @@ 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+ main :: IO () main = hspec $ do describe "onull" $ do@@ -204,6 +210,51 @@ 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)++ 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)++ 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) describe "NonNull" $ do describe "fromNonEmpty" $ do