From b6163f389506537d02dfbcfe55badd5d7794e173 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 27 Jun 2023 16:14:46 -0400 Subject: [PATCH 1/8] tails, inits, initTails inital implementation example --- mono-traversable/src/Data/Sequences.hs | 40 +++++++++++++++++++++++++- 1 file changed, 39 insertions(+), 1 deletion(-) diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index 9bab565..86047cb 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -423,7 +423,7 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is -- 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,31 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is splitWhen :: (Element seq -> Bool) -> seq -> [seq] splitWhen = defaultSplitWhen + -- | Returns all the final segments of 'seq' with the longest first. + -- + -- @since 1.0.15.4 + tails :: seq -> [seq] + tails x = x : maybe mempty tails (tailMay x) + + -- | Return all the initial segments of 'seq' with the shortest first. + -- + -- @since 1.0.15.4 + 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],[])] + -- @ + -- + -- @since 1.0.15.4 + initTails :: seq -> [(seq,seq)] + initTails seq = List.zip (inits seq) (tails seq) + {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -502,6 +527,9 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is {-# 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 +635,13 @@ instance IsSequence [a] where (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 _ [] = [] {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} @@ -625,6 +660,9 @@ instance IsSequence [a] where {-# INLINE groupBy #-} {-# INLINE groupAllOn #-} {-# INLINE splitWhen #-} + {-# INLINE tails #-} + {-# INLINE inits #-} + {-# INLINE initTails #-} instance SemiSequence (NE.NonEmpty a) where type Index (NE.NonEmpty a) = Int From ec15fb5392419323a88929cb7158a7bd4ad65f1e Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sun, 12 Nov 2023 16:56:55 -0500 Subject: [PATCH 2/8] added better initTails implementation for index based structures --- mono-traversable/src/Data/Sequences.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index 86047cb..ad1805d 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -695,6 +695,9 @@ instance SemiSequence S.ByteString where {-# INLINE cons #-} {-# INLINE snoc #-} +initTailsViaSplitAt :: IsSequence seq => seq -> [(seq, seq)] +initTailsViaSplitAt x = fmap (`splitAt` x) [0 .. lengthIndex x] + instance IsSequence S.ByteString where fromList = S.pack lengthIndex = S.length @@ -750,6 +753,9 @@ instance IsSequence S.ByteString where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = initTailsViaSplitAt + {-# INLINE initTails #-} + instance SemiSequence T.Text where type Index T.Text = Int intersperse = T.intersperse @@ -814,6 +820,9 @@ instance IsSequence T.Text where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = initTailsViaSplitAt + {-# INLINE initTails #-} + instance SemiSequence L.ByteString where type Index L.ByteString = Int64 intersperse = L.intersperse @@ -1072,6 +1081,9 @@ instance IsSequence (V.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = initTailsViaSplitAt + {-# INLINE initTails #-} + instance U.Unbox a => SemiSequence (U.Vector a) where type Index (U.Vector a) = Int @@ -1145,6 +1157,9 @@ instance U.Unbox a => IsSequence (U.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = initTailsViaSplitAt + {-# INLINE initTails #-} + instance VS.Storable a => SemiSequence (VS.Vector a) where type Index (VS.Vector a) = Int reverse = VS.reverse @@ -1218,6 +1233,9 @@ instance VS.Storable a => IsSequence (VS.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = initTailsViaSplitAt + {-# INLINE initTails #-} + -- | @'splitElem'@ splits a sequence into components delimited by separator -- element. It's equivalent to 'splitWhen' with equality predicate: -- From b5ad8363bcb5a52cf028defb004ddb49f08b07d3 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sun, 12 Nov 2023 18:17:21 -0500 Subject: [PATCH 3/8] addded non-default initTails implementation for Seq --- mono-traversable/src/Data/Sequences.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index ad1805d..108f914 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -1008,6 +1008,11 @@ instance IsSequence (Seq.Seq a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} + initTails = its . (,) mempty + where + its x@(is, y Seq.:<| ts) = x : its (is Seq.:|> y, ts) + its (_, Seq.Empty) = mempty + instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int reverse = V.reverse From 3f390a58c33e3ea32e0954fd62466fa98ff20670 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sun, 25 Feb 2024 13:47:32 -0500 Subject: [PATCH 4/8] added tests for initTails but found inconsistencies between the types It seems that the definitions for inits and tails differs between String and ByteString. --- mono-traversable/test/Main.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/mono-traversable/test/Main.hs b/mono-traversable/test/Main.hs index befda4c..ac113d3 100644 --- a/mono-traversable/test/Main.hs +++ b/mono-traversable/test/Main.hs @@ -13,7 +13,7 @@ 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.Monoid (mempty, mconcat, (<>)) import Data.Maybe (fromMaybe) import qualified Data.List as List @@ -205,6 +205,17 @@ main = hspec $ do test "works on strict texts" T.empty test "works on lazy texts" TL.empty + 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 "StrictBytestring" S.empty + test "LazyBytestring" L.empty + test "StrictText" T.empty + test "LazyText" TL.empty + test "String" (mempty :: String) + describe "NonNull" $ do describe "fromNonEmpty" $ do prop "toMinList" $ \(NonEmpty' ne) -> From ac63d4e155ce142cc1a01cfdc513e43c44bbc430 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Sun, 25 Feb 2024 14:13:30 -0500 Subject: [PATCH 5/8] fixed initTails for [a] --- mono-traversable/src/Data/Sequences.hs | 8 ++++---- mono-traversable/test/Main.hs | 24 +++++++++++++++++++++++- 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index 108f914..67c00e3 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -474,13 +474,13 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is -- | Returns all the final segments of 'seq' with the longest first. -- - -- @since 1.0.15.4 + -- @since ???? tails :: seq -> [seq] tails x = x : maybe mempty tails (tailMay x) -- | Return all the initial segments of 'seq' with the shortest first. -- - -- @since 1.0.15.4 + -- @since ???? inits :: seq -> [seq] inits seq = is seq [seq] where @@ -493,7 +493,7 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is -- [([],[1,2]), ([1],[2]), ([1,2],[])] -- @ -- - -- @since 1.0.15.4 + -- @since ???? initTails :: seq -> [(seq,seq)] initTails seq = List.zip (inits seq) (tails seq) @@ -641,7 +641,7 @@ instance IsSequence [a] where where its :: ([a] -> [a]) -> [a] -> [([a],[a])] its f xs@(y:ys) = (f [], xs) : its (f . (y:)) ys - its _ [] = [] + its f [] = [(f [], [])] {-# INLINE fromList #-} {-# INLINE break #-} {-# INLINE span #-} diff --git a/mono-traversable/test/Main.hs b/mono-traversable/test/Main.hs index ac113d3..94457e1 100644 --- a/mono-traversable/test/Main.hs +++ b/mono-traversable/test/Main.hs @@ -205,9 +205,31 @@ main = hspec $ do 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 "StrictBytestring" S.empty + test "LazyBytestring" L.empty + test "StrictText" T.empty + test "LazyText" TL.empty + test "String" (mempty :: String) + + 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 "StrictBytestring" S.empty + test "LazyBytestring" L.empty + test "StrictText" T.empty + test "LazyText" TL.empty + test "String" (mempty :: String) + describe "initTails" $ do let test typ emptyTyp = describe typ $ do - it "empty" $ initTails emptyTyp @?= [] + it "empty" $ initTails emptyTyp @?= [("","")] it "one element" $ initTails ("a" <> emptyTyp) @?= [("","a"), ("a","")] it "two elements" $ initTails ("ab" <> emptyTyp) @?= [("","ab"), ("a","b"), ("ab","")] test "StrictBytestring" S.empty From 859680253f50ebd409827d2205d19cacf3f2f0f4 Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 27 Feb 2024 10:19:23 -0500 Subject: [PATCH 6/8] Upped version, example mappings --- mono-traversable/mono-traversable.cabal | 2 +- mono-traversable/package.yaml | 2 +- mono-traversable/src/Data/Sequences.hs | 26 ++++++++++++++++++++----- 3 files changed, 23 insertions(+), 7 deletions(-) diff --git a/mono-traversable/mono-traversable.cabal b/mono-traversable/mono-traversable.cabal index 3502f2b..ce23ff3 100644 --- a/mono-traversable/mono-traversable.cabal +++ b/mono-traversable/mono-traversable.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: mono-traversable -version: 1.0.16.0 +version: 1.0.17.0 synopsis: Type classes for mapping, folding, and traversing monomorphic containers description: Please see the README at category: Data diff --git a/mono-traversable/package.yaml b/mono-traversable/package.yaml index 4aac507..3b46d56 100644 --- a/mono-traversable/package.yaml +++ b/mono-traversable/package.yaml @@ -1,5 +1,5 @@ name: mono-traversable -version: 1.0.16.0 +version: 1.0.17.0 synopsis: Type classes for mapping, folding, and traversing monomorphic containers description: Please see the README at category: Data diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index 67c00e3..e3d8988 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -474,13 +474,27 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is -- | Returns all the final segments of 'seq' with the longest first. -- - -- @since ???? + -- @ + -- > 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. -- - -- @since ???? + -- @ + -- > inits [1,2] + -- [[],[1],[1,2]] + -- > inits [] + -- [[]] + -- @ + -- + -- @since 1.0.17.0 inits :: seq -> [seq] inits seq = is seq [seq] where @@ -489,11 +503,13 @@ class (Monoid seq, MonoTraversable seq, SemiSequence seq, MonoPointed seq) => Is -- | Return all the pairs of inital and final segments of 'seq'. -- -- @ - -- > 'initTails' [1,2] - -- [([],[1,2]), ([1],[2]), ([1,2],[])] + -- > initTails [1,2] + -- [([],[1,2]),([1],[2]),([1,2],[])] + -- > initTails [] + -- [([],[])] -- @ -- - -- @since ???? + -- @since 1.0.17.0 initTails :: seq -> [(seq,seq)] initTails seq = List.zip (inits seq) (tails seq) From 648f1f58f2cd321428b4318b6e70ebde32cf573e Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 27 Feb 2024 23:18:02 -0500 Subject: [PATCH 7/8] Added benchmarks for initTails Benchmarks showed that some specialized instances of initTails based on splitOn were slower than the default definition, so I removed them. Added reccommended flags for benchmarking. Added change log entry. --- mono-traversable/ChangeLog.md | 6 ++ mono-traversable/bench/InitTails.hs | 90 +++++++++++++++++++ .../bench/{sorting.hs => Sorting.hs} | 12 ++- mono-traversable/bench/main.hs | 17 ++++ mono-traversable/mono-traversable.cabal | 16 +++- mono-traversable/package.yaml | 12 ++- mono-traversable/src/Data/Sequences.hs | 21 +---- mono-traversable/test/Main.hs | 14 ++- 8 files changed, 157 insertions(+), 31 deletions(-) create mode 100644 mono-traversable/bench/InitTails.hs rename mono-traversable/bench/{sorting.hs => Sorting.hs} (82%) create mode 100644 mono-traversable/bench/main.hs diff --git a/mono-traversable/ChangeLog.md b/mono-traversable/ChangeLog.md index 6aaa727..df87056 100644 --- a/mono-traversable/ChangeLog.md +++ b/mono-traversable/ChangeLog.md @@ -1,5 +1,11 @@ # 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 diff --git a/mono-traversable/bench/InitTails.hs b/mono-traversable/bench/InitTails.hs new file mode 100644 index 0000000..4c98c8d --- /dev/null +++ b/mono-traversable/bench/InitTails.hs @@ -0,0 +1,90 @@ +{-# 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]) + , ("extream", [1000000]) + ] + +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' (\() (_,_) -> ()) () + diff --git a/mono-traversable/bench/sorting.hs b/mono-traversable/bench/Sorting.hs similarity index 82% rename from mono-traversable/bench/sorting.hs rename to mono-traversable/bench/Sorting.hs index ac68041..3a4710f 100644 --- a/mono-traversable/bench/sorting.hs +++ b/mono-traversable/bench/Sorting.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +module Sorting (sortingBenchmarks) where #if MIN_VERSION_gauge(0,2,0) import Gauge @@ -12,6 +13,13 @@ 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 @@ -19,10 +27,6 @@ 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 diff --git a/mono-traversable/bench/main.hs b/mono-traversable/bench/main.hs new file mode 100644 index 0000000..84dce01 --- /dev/null +++ b/mono-traversable/bench/main.hs @@ -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 + ] diff --git a/mono-traversable/mono-traversable.cabal b/mono-traversable/mono-traversable.cabal index ce23ff3..1baf9a9 100644 --- a/mono-traversable/mono-traversable.cabal +++ b/mono-traversable/mono-traversable.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -72,18 +72,26 @@ test-suite test , 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 diff --git a/mono-traversable/package.yaml b/mono-traversable/package.yaml index 3b46d56..8ecade0 100644 --- a/mono-traversable/package.yaml +++ b/mono-traversable/package.yaml @@ -45,15 +45,23 @@ tests: - unordered-containers - foldl benchmarks: - sorting: - main: sorting.hs + all: + main: main.hs source-dirs: bench ghc-options: - -Wall - -O2 + - -with-rtsopts=-A32m + when: + - condition: impl(ghc >= 8.6) + ghc-options: -fproc-alignment=64 dependencies: - base - gauge - mono-traversable + - text + - containers + - bytestring - vector - mwc-random + - deepseq diff --git a/mono-traversable/src/Data/Sequences.hs b/mono-traversable/src/Data/Sequences.hs index e3d8988..e6d0503 100644 --- a/mono-traversable/src/Data/Sequences.hs +++ b/mono-traversable/src/Data/Sequences.hs @@ -711,9 +711,6 @@ instance SemiSequence S.ByteString where {-# INLINE cons #-} {-# INLINE snoc #-} -initTailsViaSplitAt :: IsSequence seq => seq -> [(seq, seq)] -initTailsViaSplitAt x = fmap (`splitAt` x) [0 .. lengthIndex x] - instance IsSequence S.ByteString where fromList = S.pack lengthIndex = S.length @@ -769,9 +766,6 @@ instance IsSequence S.ByteString where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} - initTails = initTailsViaSplitAt - {-# INLINE initTails #-} - instance SemiSequence T.Text where type Index T.Text = Int intersperse = T.intersperse @@ -836,9 +830,6 @@ instance IsSequence T.Text where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} - initTails = initTailsViaSplitAt - {-# INLINE initTails #-} - instance SemiSequence L.ByteString where type Index L.ByteString = Int64 intersperse = L.intersperse @@ -1027,7 +1018,8 @@ instance IsSequence (Seq.Seq a) where initTails = its . (,) mempty where its x@(is, y Seq.:<| ts) = x : its (is Seq.:|> y, ts) - its (_, Seq.Empty) = mempty + its x@(_, Seq.Empty) = [x] + {-# INLINE initTails #-} instance SemiSequence (V.Vector a) where type Index (V.Vector a) = Int @@ -1102,9 +1094,6 @@ instance IsSequence (V.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} - initTails = initTailsViaSplitAt - {-# INLINE initTails #-} - instance U.Unbox a => SemiSequence (U.Vector a) where type Index (U.Vector a) = Int @@ -1178,9 +1167,6 @@ instance U.Unbox a => IsSequence (U.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} - initTails = initTailsViaSplitAt - {-# INLINE initTails #-} - instance VS.Storable a => SemiSequence (VS.Vector a) where type Index (VS.Vector a) = Int reverse = VS.reverse @@ -1254,9 +1240,6 @@ instance VS.Storable a => IsSequence (VS.Vector a) where {-# INLINE indexEx #-} {-# INLINE unsafeIndex #-} - initTails = initTailsViaSplitAt - {-# INLINE initTails #-} - -- | @'splitElem'@ splits a sequence into components delimited by separator -- element. It's equivalent to 'splitWhen' with equality predicate: -- diff --git a/mono-traversable/test/Main.hs b/mono-traversable/test/Main.hs index 94457e1..4b39b20 100644 --- a/mono-traversable/test/Main.hs +++ b/mono-traversable/test/Main.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} @@ -39,13 +40,14 @@ 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) + 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 @@ fromListAs xs _ = fromList xs 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 @@ -232,11 +238,15 @@ main = hspec $ 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 "String" (mempty :: String) + 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 From 84ced1506a929928ebd78579bd6a81ab4b6e611e Mon Sep 17 00:00:00 2001 From: William Rusnack Date: Tue, 27 Feb 2024 23:40:25 -0500 Subject: [PATCH 8/8] Added all types to inits and tails tests, removed extream benchmark --- mono-traversable/bench/InitTails.hs | 1 - mono-traversable/test/Main.hs | 12 ++++++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/mono-traversable/bench/InitTails.hs b/mono-traversable/bench/InitTails.hs index 4c98c8d..1a6a721 100644 --- a/mono-traversable/bench/InitTails.hs +++ b/mono-traversable/bench/InitTails.hs @@ -64,7 +64,6 @@ bmg = bgroup (testLabel @seq) $ bm <$> labelledLengths , ("small", [100,150,200,300]) , ("medium", [1000,1500,2000,2500]) , ("large", [10000,20000,50000]) - , ("extream", [1000000]) ] class Typeable a => TestLabel a where diff --git a/mono-traversable/test/Main.hs b/mono-traversable/test/Main.hs index 4b39b20..e862269 100644 --- a/mono-traversable/test/Main.hs +++ b/mono-traversable/test/Main.hs @@ -216,22 +216,30 @@ main = hspec $ 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 "String" (mempty :: String) + 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 "String" (mempty :: String) + 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