diff --git a/acc.cabal b/acc.cabal --- a/acc.cabal +++ b/acc.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: acc -version: 0.2.0.2 +version: 0.2.0.3 synopsis: Sequence optimized for monoidal construction and folding description: Data structure intended for accumulating a sequence of elements @@ -80,7 +80,7 @@ Acc.Prelude build-depends: - base >=4.13 && <5 + , base >=4.13 && <5 , deepseq >=1.4 && <2 , semigroupoids >=5.3 && <7 @@ -134,7 +134,7 @@ -O2 -threaded -with-rtsopts=-N -rtsopts -funbox-strict-fields build-depends: - acc + , acc , criterion >=1.6 && <2 , rerebase >=1.19 && <2 @@ -185,8 +185,9 @@ default-language: Haskell2010 main-is: Main.hs build-depends: - acc + , acc , quickcheck-instances >=0.3.11 && <0.4 , rerebase >=1.9 && <2 , tasty >=0.12 && <2 + , tasty-hunit ^>=0.10 , tasty-quickcheck >=0.9 && <0.11 diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,71 +1,73 @@ module Main where import qualified Acc -import qualified Data.DList as DList -import qualified Data.Sequence as Sequence import Criterion import Criterion.Main +import qualified Data.DList as DList +import qualified Data.Sequence as Sequence import Prelude main :: IO () main = defaultMain - [ bgroup "sum" $ - [ onIntListByMagBench "cons" 4 $ \input -> - [ reduceConstructBench "acc" input sum $ - foldl' (flip Acc.cons) mempty, - reduceConstructBench "list" input sum $ - foldl' (flip (:)) [], - reduceConstructBench "dlist" input sum $ - foldl' (flip DList.cons) mempty, - reduceConstructBench "sequence" input sum $ - foldl' (flip (Sequence.<|)) mempty - ], - onIntListByMagBench "snoc" 4 $ \input -> - [ reduceConstructBench "acc" input sum $ - foldl' (flip Acc.snoc) mempty, - reduceConstructBench "dlist" input sum $ - foldl' DList.snoc mempty, - reduceConstructBench "sequence" input sum $ - foldl' (Sequence.|>) mempty - ], - onIntListByMagBench "fromList" 4 $ \input -> - [ reduceConstructBench "acc" input sum $ fromList @(Acc.Acc Int), - reduceConstructBench "list" input sum $ id, - reduceConstructBench "dlist" input sum $ DList.fromList, - reduceConstructBench "sequence" input sum $ Sequence.fromList - ], - bgroup "append" $ - [ bgroup "left" $ - onIntListByMagBenchList 4 $ \input -> - onSizeByMagBenchList 4 $ \appendAmount -> - [ appendLeftBench "acc" appendAmount (fromList @(Acc.Acc Int) input) sum, - appendLeftBench "list" appendAmount input sum, - appendLeftBench "dlist" appendAmount (DList.fromList input) sum, - appendLeftBench "sequence" appendAmount (Sequence.fromList input) sum - ], - bgroup "right" $ - onIntListByMagBenchList 4 $ \input -> - onSizeByMagBenchList 4 $ \appendAmount -> - [ appendRightBench "acc" appendAmount (fromList @(Acc.Acc Int) input) sum, - appendRightBench "list" appendAmount input sum, - appendRightBench "dlist" appendAmount (DList.fromList input) sum, - appendRightBench "sequence" appendAmount (Sequence.fromList input) sum - ] - ] - ], - bgroup "length" $ - [ onIntListByMagBench "cons" 4 $ \input -> - [ reduceConstructBench "acc" input length $ - foldl' (flip Acc.cons) mempty, - reduceConstructBench "list" input length $ - foldl' (flip (:)) [], - reduceConstructBench "dlist" input length $ - foldl' (flip DList.cons) mempty, - reduceConstructBench "sequence" input length $ - foldl' (flip (Sequence.<|)) mempty - ] - ] + [ bgroup "sum" + $ [ onIntListByMagBench "cons" 4 $ \input -> + [ reduceConstructBench "acc" input sum + $ foldl' (flip Acc.cons) mempty, + reduceConstructBench "list" input sum + $ foldl' (flip (:)) [], + reduceConstructBench "dlist" input sum + $ foldl' (flip DList.cons) mempty, + reduceConstructBench "sequence" input sum + $ foldl' (flip (Sequence.<|)) mempty + ], + onIntListByMagBench "snoc" 4 $ \input -> + [ reduceConstructBench "acc" input sum + $ foldl' (flip Acc.snoc) mempty, + reduceConstructBench "dlist" input sum + $ foldl' DList.snoc mempty, + reduceConstructBench "sequence" input sum + $ foldl' (Sequence.|>) mempty + ], + onIntListByMagBench "fromList" 4 $ \input -> + [ reduceConstructBench "acc" input sum $ fromList @(Acc.Acc Int), + reduceConstructBench "list" input sum $ id, + reduceConstructBench "dlist" input sum $ DList.fromList, + reduceConstructBench "sequence" input sum $ Sequence.fromList + ], + bgroup "append" + $ [ bgroup "left" + $ onIntListByMagBenchList 4 + $ \input -> + onSizeByMagBenchList 4 $ \appendAmount -> + [ appendLeftBench "acc" appendAmount (fromList @(Acc.Acc Int) input) sum, + appendLeftBench "list" appendAmount input sum, + appendLeftBench "dlist" appendAmount (DList.fromList input) sum, + appendLeftBench "sequence" appendAmount (Sequence.fromList input) sum + ], + bgroup "right" + $ onIntListByMagBenchList 4 + $ \input -> + onSizeByMagBenchList 4 $ \appendAmount -> + [ appendRightBench "acc" appendAmount (fromList @(Acc.Acc Int) input) sum, + appendRightBench "list" appendAmount input sum, + appendRightBench "dlist" appendAmount (DList.fromList input) sum, + appendRightBench "sequence" appendAmount (Sequence.fromList input) sum + ] + ] + ], + bgroup "length" + $ [ onIntListByMagBench "cons" 4 $ \input -> + [ reduceConstructBench "acc" input length + $ foldl' (flip Acc.cons) mempty, + reduceConstructBench "list" input length + $ foldl' (flip (:)) [], + reduceConstructBench "dlist" input length + $ foldl' (flip DList.cons) mempty, + reduceConstructBench "sequence" input length + $ foldl' (flip (Sequence.<|)) mempty + ] + ] ] -- | @@ -104,8 +106,8 @@ appendLeftBench name appendAmount chunk reducer = let input = replicate appendAmount chunk - in reduceConstructBench name input reducer $ - foldl' (flip (<>)) mempty + in reduceConstructBench name input reducer + $ foldl' (flip (<>)) mempty -- | -- Construct a benchmark that measures appending from the right side of a @@ -125,8 +127,8 @@ appendRightBench name appendAmount chunk reducer = let input = replicate appendAmount chunk - in reduceConstructBench name input reducer $ - foldl' (<>) mempty + in reduceConstructBench name input reducer + $ foldl' (<>) mempty onIntListByMagBench :: String -> Int -> ([Int] -> [Benchmark]) -> Benchmark onIntListByMagBench groupName amount benchmarks = diff --git a/library/Acc.hs b/library/Acc.hs --- a/library/Acc.hs +++ b/library/Acc.hs @@ -13,7 +13,7 @@ import qualified Acc.NeAcc as NeAcc import qualified Acc.NeAcc.Def as NeAcc -import Acc.Prelude hiding (enumFromTo, toNonEmpty) +import Acc.Prelude hiding (enumFromTo, toNonEmpty, unsnoc) import qualified Data.Semigroup.Foldable as Foldable1 -- | diff --git a/library/Acc/NeAcc/Def.hs b/library/Acc/NeAcc/Def.hs --- a/library/Acc/NeAcc/Def.hs +++ b/library/Acc/NeAcc/Def.hs @@ -10,7 +10,7 @@ ) where -import Acc.Prelude hiding (foldM) +import Acc.Prelude hiding (foldM, unsnoc) -- | -- Non-empty accumulator. @@ -290,7 +290,7 @@ unsnocTo buff = \case Branch l r -> - unsnocTo (Branch l buff) r + unsnocTo (Branch buff l) r Leaf a -> (a, buff) diff --git a/library/Acc/Prelude.hs b/library/Acc/Prelude.hs --- a/library/Acc/Prelude.hs +++ b/library/Acc/Prelude.hs @@ -26,13 +26,13 @@ import Data.Fixed as Exports import Data.Foldable as Exports hiding (toList) import Data.Function as Exports hiding (id, (.)) -import Data.Functor as Exports +import Data.Functor as Exports hiding (unzip) import Data.Functor.Alt as Exports hiding (many, optional, some) import Data.Functor.Compose as Exports import Data.IORef as Exports import Data.Int as Exports import Data.Ix as Exports -import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons) +import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons, unsnoc) import Data.List.NonEmpty as Exports (NonEmpty (..)) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt, First (..), Last (..), (<>)) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,20 +1,22 @@ {-# OPTIONS_GHC -Wno-orphans #-} + module Main where import Acc import qualified Data.List.NonEmpty as NonEmpty import Test.QuickCheck.Instances () import Test.Tasty +import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Prelude hiding (assert) main :: IO () main = - defaultMain $ - testGroup + defaultMain + $ testGroup "All tests" - [ testProperty "Acc converted to list and reconstructed from it converts to the same list again" $ - \(acc :: Acc Int) -> + [ testProperty "Acc converted to list and reconstructed from it converts to the same list again" + $ \(acc :: Acc Int) -> let list = toList acc acc' :: Acc Int @@ -23,35 +25,57 @@ list' = toList acc' in list === list', - testProperty "foldl" $ - \(acc :: Acc Int) -> + testProperty "foldl" + $ \(acc :: Acc Int) -> foldl (flip (:)) [] acc === foldl (flip (:)) [] (toList acc), - testProperty "foldl'" $ - \(acc :: Acc Int) -> + testProperty "foldl'" + $ \(acc :: Acc Int) -> foldl' (flip (:)) [] acc === foldl' (flip (:)) [] (toList acc), - testProperty "foldr" $ - \(acc :: Acc Int) -> + testProperty "foldr" + $ \(acc :: Acc Int) -> foldr (:) [] acc === foldr (:) [] (toList acc), - testProperty "foldr'" $ - \(acc :: Acc Int) -> + testProperty "foldr'" + $ \(acc :: Acc Int) -> foldr' (:) [] acc === foldr' (:) [] (toList acc), - testProperty "foldMap" $ - \(acc :: Acc Int) -> + testProperty "foldMap" + $ \(acc :: Acc Int) -> foldMap (: []) acc === foldMap (: []) (toList acc), - testProperty "foldMap'" $ - \(acc :: Acc Int) -> + testProperty "foldMap'" + $ \(acc :: Acc Int) -> foldMap' (: []) acc === foldMap' (: []) (toList acc), - testProperty "toNonEmpty" $ - \(acc :: Acc Int) -> + testProperty "toNonEmpty" + $ \(acc :: Acc Int) -> Acc.toNonEmpty acc - === NonEmpty.nonEmpty (toList acc) + === NonEmpty.nonEmpty (toList acc), + testProperty "snoccing an unsnocced element of an acc produces the same acc" + $ \(acc :: Acc Int) -> + case Acc.unsnoc acc of + Just (lastElement, prefix) -> + toList (Acc.snoc lastElement prefix) === toList acc + Nothing -> + discard, + testGroup "Issue #10" + $ [ testCase "" $ do + assertEqual + "" + (Acc.unsnoc $ Acc.cons 2 $ Acc.cons 1 $ Acc.cons 1 mempty) + (Just (1, fromList [2, 1])), + testCase "" $ do + assertEqual + "" + (Acc.cons 2 $ Acc.cons 1 $ Acc.cons 1 mempty) + (fromList [2, 1, 1]) + ] ] + +instance (Eq a) => Eq (Acc a) where + a == b = toList a == toList b instance (Arbitrary a) => Arbitrary (Acc a) where arbitrary =