acc (empty) → 0.1
raw patch · 8 files changed
+816/−0 lines, 8 filesdep +QuickCheckdep +accdep +basesetup-changed
Dependencies added: QuickCheck, acc, base, criterion, deepseq, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- acc.cabal +70/−0
- benchmark/Main.hs +273/−0
- library/Acc.hs +129/−0
- library/Acc/BinTree1.hs +165/−0
- library/Acc/Prelude.hs +79/−0
- test/Main.hs +76/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2020 Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ acc.cabal view
@@ -0,0 +1,70 @@+name: acc+version: 0.1+synopsis: Sequence optimized for monoidal construction and folding+description:+ Data structure intended for accumulating a sequence of elements+ for later traversal or folding.+ Useful for implementing all kinds of builders on top.+ .+ The benchmarks show that for the described use-case it+ is on average 2 times faster than 'Data.DList.DList' and 'Data.Sequence.Seq',+ is on par with list when you always prepend elements and+ is exponentially faster than list when you append.+homepage: https://github.com/nikita-volkov/acc+bug-reports: https://github.com/nikita-volkov/acc/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2020 Nikita Volkov+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/nikita-volkov/acc.git++library+ hs-source-dirs: library+ default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns+ default-language: Haskell2010+ exposed-modules:+ Acc+ other-modules:+ Acc.BinTree1+ Acc.Prelude+ build-depends:+ base >=4.13 && <5,+ deepseq >=1.4.4 && <1.5++benchmark benchmark+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmark+ main-is: Main.hs+ default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns+ default-language: Haskell2010+ ghc-options:+ -O2+ -threaded+ "-with-rtsopts=-N"+ -rtsopts+ -funbox-strict-fields+ build-depends:+ acc,+ criterion >=1.5.6 && <2,+ rerebase >=1.9 && <2++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ default-extensions: BangPatterns, BlockArguments, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, DerivingVia, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, StrictData, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples, ViewPatterns+ default-language: Haskell2010+ main-is: Main.hs+ build-depends:+ acc,+ QuickCheck >=2.8.1 && <3,+ quickcheck-instances >=0.3.11 && <0.4,+ rerebase >=1.9 && <2,+ tasty >=0.12 && <2,+ tasty-hunit >=0.9 && <0.11,+ tasty-quickcheck >=0.9 && <0.11
+ benchmark/Main.hs view
@@ -0,0 +1,273 @@+module Main where++import Prelude+import Criterion+import Criterion.Main+import qualified Acc+import qualified Data.Foldable as Foldable+import qualified Data.Sequence as Seq+import qualified Data.DList as DList+import qualified Data.Vector as Vector+++main =+ defaultMain [+ sumBgroup "1"+ (replicate 1000 1)+ (foldMapToRight)+ ,+ sumBgroup "2"+ (replicate 1000 1)+ (foldMapToLeft)+ ,+ sumBgroup "sum/foldr',foldr'"+ (Vector.fromList (replicate 100 (Vector.fromList (replicate @Int 100 1))))+ (\ singleton -> foldr' (\ a b -> foldr' (mappend . singleton) mempty a <> b) mempty)+ ,+ sumBgroup "sum/foldl',foldl'"+ (Vector.fromList (replicate 100 (Vector.fromList (replicate @Int 100 1))))+ (\ singleton -> foldl' (\ a b -> a <> foldl' (\ a -> mappend a . singleton) mempty b) mempty)+ ,+ bgroup "thousand-elements" [+ bgroup "foldl'" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldl' (<>) mempty $ fmap (pure @Acc.Acc) input+ in Foldable.toList acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldl' (<>) mempty $ fmap Seq.singleton input+ in Foldable.toList seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldl' (<>) mempty $ fmap DList.singleton input+ in Foldable.toList seq+ in nf work input+ ]+ ,+ bgroup "foldr" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldr (<>) mempty $ fmap (pure @Acc.Acc) input+ in Foldable.toList acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldr (<>) mempty $ fmap Seq.singleton input+ in Foldable.toList seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldr (<>) mempty $ fmap DList.singleton input+ in Foldable.toList seq+ in nf work input+ ]+ ,+ bgroup "foldr'" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldr' (<>) mempty $ fmap (pure @Acc.Acc) input+ in Foldable.toList acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldr' (<>) mempty $ fmap Seq.singleton input+ in Foldable.toList seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldr' (<>) mempty $ fmap DList.singleton input+ in Foldable.toList seq+ in nf work input+ ]+ ,+ bgroup "foldr, force intermediate" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldr (<>) mempty $ fmap (pure @Acc.Acc) input+ in Foldable.toList $!! acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldr (<>) mempty $ fmap Seq.singleton input+ in Foldable.toList $!! seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldr (<>) mempty $ fmap DList.singleton input+ in Foldable.toList $!! seq+ in nf work input+ ]+ ,+ bgroup "foldMap" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldMap (pure @Acc.Acc) input+ in Foldable.toList acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldMap Seq.singleton input+ in Foldable.toList seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldMap DList.singleton input+ in Foldable.toList seq+ in nf work input+ ]+ ,+ bgroup "foldMap'" $ let+ !input =+ force $ enumFromTo 0 999 :: [Int]+ in [+ bench "Acc" $ let+ work input =+ let+ acc =+ foldMap' (pure @Acc.Acc) input+ in Foldable.toList acc+ in nf work input+ ,+ bench "Seq" $ let+ work input =+ let+ seq =+ foldMap' Seq.singleton input+ in Foldable.toList seq+ in nf work input+ ,+ bench "DList" $ let+ work input =+ let+ seq =+ foldMap' DList.singleton input+ in Foldable.toList seq+ in nf work input+ ]+ ]+ ,+ bgroup "groups" [+ bgroup "foldl'" [+ bench "acc" $ let+ input :: [Acc.Acc Int]+ !input =+ enumFromTo 0 99 & fmap pure &+ foldl' (<>) mempty &+ replicate 10 &+ force+ work =+ Foldable.toList . foldl' (<>) mempty+ in nf work input+ ,+ bench "seq" $ let+ input :: [Seq Int]+ !input =+ enumFromTo 0 99 & fmap pure &+ foldl' (<>) mempty &+ replicate 10 &+ force+ work =+ Foldable.toList . foldl' (<>) mempty+ in nf work input+ ,+ bench "dlist" $ let+ input :: [DList Int]+ !input =+ enumFromTo 0 99 & fmap pure &+ foldl' (<>) mempty &+ replicate 10 &+ force+ work =+ Foldable.toList . foldl' (<>) mempty+ in nf work input+ ]+ ]+ ]++sumBgroup :: NFData input => String -> input -> (forall f. (Foldable f, Monoid (f Int)) => (Int -> f Int) -> input -> f Int) -> Benchmark+sumBgroup name (force -> !input) build =+ bgroup name [+ sumBench "Acc" (pure @Acc.Acc)+ ,+ sumBench "Seq" Seq.singleton+ ,+ sumBench "DList" DList.singleton+ ,+ sumBench "List" (pure @[])+ ]+ where+ sumBench :: (Foldable f, Monoid (f Int)) => String -> (Int -> f Int) -> Benchmark+ sumBench name singleton =+ bench name (nf (Foldable.sum . build singleton) input)++++{-| Best for Acc. -}+{-# NOINLINE foldMapToRight #-}+foldMapToRight :: Monoid m => (a -> m) -> [a] -> m+foldMapToRight pure =+ foldl' (\ a b -> pure b <> a) mempty++{-| Worst for Acc. -}+{-# NOINLINE foldMapToLeft #-}+foldMapToLeft :: Monoid m => (a -> m) -> [a] -> m+foldMapToLeft pure =+ foldl' (\ a b -> a <> pure b) mempty
+ library/Acc.hs view
@@ -0,0 +1,129 @@+module Acc+(+ Acc,+)+where++import Acc.Prelude+import qualified Acc.BinTree1 as BinTree1+import qualified Data.Foldable as Foldable+++{-|+Data structure intended for accumulating a sequence of elements+for later traversal or folding.+Useful for implementing all kinds of builders on top.++To produce a single element 'Acc' use 'pure'.+To produce a multielement 'Acc' use 'fromList'.+To combine use '<|>' or '<>' and other 'Alternative' and 'Monoid'-related utils.+To extract elements use 'Foldable' API.++The benchmarks show that for the described use-case this data-structure+is on average 2 times faster than 'Data.DList.DList' and 'Data.Sequence.Seq',+is on par with list when you always prepend elements and+is exponentially faster than list when you append.++Internally it is implemented as a simple binary tree+with all functions optimized to use tail recursion,+ensuring that you don\'t get stack overflow.+-}+data Acc a =+ EmptyAcc |+ TreeAcc !(BinTree1.BinTree1 a)+ deriving (Generic, Generic1)++instance NFData a => NFData (Acc a)++instance NFData1 Acc++deriving instance Functor Acc++instance Foldable Acc where+ foldMap f =+ \ case+ TreeAcc a ->+ foldMap f a+ EmptyAcc ->+ mempty+ foldMap' f =+ \ case+ TreeAcc a ->+ foldMap' f a+ EmptyAcc ->+ mempty+ foldr step acc =+ \ case+ TreeAcc a ->+ foldr step acc a+ EmptyAcc ->+ acc+ foldr' step acc =+ \ case+ TreeAcc a ->+ foldr' step acc a+ EmptyAcc ->+ acc+ foldl' step acc =+ \ case+ TreeAcc a ->+ foldl' step acc a+ EmptyAcc ->+ acc+ sum =+ foldl' (+) 0++deriving instance Traversable Acc++instance Applicative Acc where+ pure =+ TreeAcc . BinTree1.Leaf+ (<*>) =+ \ case+ TreeAcc a ->+ \ case+ TreeAcc b ->+ TreeAcc (BinTree1.ap a b)+ EmptyAcc ->+ EmptyAcc+ EmptyAcc ->+ const EmptyAcc++instance Alternative Acc where+ empty =+ EmptyAcc+ (<|>) =+ \ case+ TreeAcc a ->+ \ case+ TreeAcc b ->+ TreeAcc (BinTree1.Branch a b)+ EmptyAcc ->+ TreeAcc a+ EmptyAcc ->+ id++instance Semigroup (Acc a) where+ (<>) =+ (<|>)++instance Monoid (Acc a) where+ mempty =+ empty++instance IsList (Acc a) where+ type Item (Acc a) = a+ fromList =+ \ case+ a : b -> TreeAcc (BinTree1.fromList1 a b)+ _ -> EmptyAcc+ toList =+ \ case+ TreeAcc a ->+ foldr (:) [] a+ _ ->+ []++instance Show a => Show (Acc a) where+ show =+ show . toList
+ library/Acc/BinTree1.hs view
@@ -0,0 +1,165 @@+module Acc.BinTree1+(+ BinTree1(..),+ foldM,+ ap,+ fromList1,+ foldMapDef,+ foldMapDef',+ foldrDef,+ foldrDef',+ foldlDef',+)+where++import Acc.Prelude hiding (foldM, ap)+import qualified Acc.Prelude as Prelude+++data BinTree1 a =+ Leaf !a |+ Branch !(BinTree1 a) !(BinTree1 a)+ deriving (Generic, Generic1, Show)++instance NFData a => NFData (BinTree1 a)++instance NFData1 BinTree1++deriving instance Functor BinTree1++instance Foldable BinTree1 where+ foldMap =+ foldMapDef+ foldMap' =+ foldMapDef'+ foldr =+ foldrDef+ foldr' =+ foldrDef'+ foldl' =+ foldlDef'++foldM :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> m a+foldM step !acc =+ \ case+ Branch a b -> foldMOnBranch step acc a b+ Leaf a -> step acc a++foldMOnBranch :: Monad m => (a -> b -> m a) -> a -> BinTree1 b -> BinTree1 b -> m a+foldMOnBranch step acc a b =+ case a of+ Leaf c -> step acc c >>= \ acc' -> foldM step acc' b+ Branch c d -> foldMOnBranch step acc c (Branch d b)++foldrDef :: (a -> b -> b) -> b -> BinTree1 a -> b+foldrDef step acc =+ \ case+ Branch a b ->+ foldrOnBranch step acc a b+ Leaf a ->+ step a acc++foldrOnBranch :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b+foldrOnBranch step acc a b =+ case a of+ Leaf c ->+ step c (foldrDef step acc b)+ Branch c d ->+ foldrOnBranch step acc c (Branch d b)++foldrDef' :: (a -> b -> b) -> b -> BinTree1 a -> b+foldrDef' step !acc =+ \ case+ Branch a b -> foldrOnBranch' step acc a b+ Leaf a -> step a acc++foldrOnBranch' :: (a -> b -> b) -> b -> BinTree1 a -> BinTree1 a -> b+foldrOnBranch' step acc a b =+ case b of+ Leaf c -> foldrDef' step (step c acc) a+ Branch c d -> foldrOnBranch' step acc (Branch a c) d++foldlDef' :: (b -> a -> b) -> b -> BinTree1 a -> b+foldlDef' step !acc =+ \ case+ Branch a b ->+ foldlOnBranch' step acc a b+ Leaf a ->+ step acc a++foldlOnBranch' :: (b -> a -> b) -> b -> BinTree1 a -> BinTree1 a -> b+foldlOnBranch' step acc a b =+ case a of+ Leaf c ->+ foldlDef' step (step acc c) b+ Branch c d ->+ foldlOnBranch' step acc c (Branch d b)++foldMapDef :: Monoid m => (a -> m) -> BinTree1 a -> m+foldMapDef =+ foldMapWithAcc mempty++foldMapWithAcc :: Monoid m => m -> (a -> m) -> BinTree1 a -> m+foldMapWithAcc acc map =+ \ case+ Branch a b -> foldMapOnBranch acc map a b+ Leaf a -> acc <> map a++foldMapOnBranch :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m+foldMapOnBranch acc map a b =+ case a of+ Leaf c -> foldMapWithAcc (acc <> map c) map b+ Branch c d -> foldMapOnBranch acc map c (Branch d b)++foldMapDef' :: Monoid m => (a -> m) -> BinTree1 a -> m+foldMapDef' =+ foldMapWithAcc' mempty++foldMapWithAcc' :: Monoid m => m -> (a -> m) -> BinTree1 a -> m+foldMapWithAcc' !acc map =+ \ case+ Branch a b -> foldMapOnBranch' acc map a b+ Leaf a -> acc <> map a++foldMapOnBranch' :: Monoid m => m -> (a -> m) -> BinTree1 a -> BinTree1 a -> m+foldMapOnBranch' acc map a b =+ case a of+ Leaf c -> foldMapWithAcc' (acc <> map c) map b+ Branch c d -> foldMapOnBranch' acc map c (Branch d b)++instance Traversable BinTree1 where+ traverse map =+ \ case+ Branch a b ->+ traverseOnBranch map a b+ Leaf a ->+ Leaf <$> map a++traverseOnBranch :: Applicative f => (a -> f b) -> BinTree1 a -> BinTree1 a -> f (BinTree1 b)+traverseOnBranch map a b =+ case a of+ Leaf c ->+ Branch <$> Leaf <$> map c <*> traverse map b+ Branch c d ->+ traverseOnBranch map a (Branch d b)++ap :: BinTree1 (a -> b) -> BinTree1 a -> BinTree1 b+ap =+ \ case+ Branch a b ->+ \ c ->+ Branch (ap a c) (ap b c)+ Leaf a ->+ fmap a ++fromList1 :: a -> [a] -> BinTree1 a+fromList1 a =+ \ case+ b : c -> fromList1WithAcc (Leaf a) b c+ _ -> Leaf a++fromList1WithAcc :: BinTree1 a -> a -> [a] -> BinTree1 a+fromList1WithAcc leftTree a =+ \ case+ b : c -> fromList1WithAcc (Branch leftTree (Leaf a)) b c+ _ -> Branch leftTree (Leaf a)
+ library/Acc/Prelude.hs view
@@ -0,0 +1,79 @@+module Acc.Prelude+( + module Exports,+)+where++-- base+-------------------------+import Control.Applicative as Exports+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+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.Compose as Exports+import Data.Functor.Contravariant as Exports+import Data.Int as Exports+import Data.IORef as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.List.NonEmpty as Exports (NonEmpty(..))+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Alt)+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports+import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith)+import GHC.Generics as Exports (Generic, Generic1)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither)+import Unsafe.Coerce as Exports++-- deepseq+-------------------------+import Control.DeepSeq as Exports
+ test/Main.hs view
@@ -0,0 +1,76 @@+module Main where++import Prelude hiding (assert)+import GHC.Exts (fromList)+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Acc+import qualified Test.QuickCheck as QuickCheck+++main =+ defaultMain $ + testGroup "All tests" [+ 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+ acc' =+ fromList list+ list' =+ toList acc'+ in list === list'+ ,+ testProperty "foldl'" $+ \ (acc :: Acc Int) ->+ foldl' (flip (:)) [] acc ===+ foldl' (flip (:)) [] (toList acc)+ ,+ testProperty "foldr" $+ \ (acc :: Acc Int) ->+ foldr (:) [] acc ===+ foldr (:) [] (toList acc)+ ,+ testProperty "foldr'" $+ \ (acc :: Acc Int) ->+ foldr' (:) [] acc ===+ foldr' (:) [] (toList acc)+ ,+ testProperty "foldMap" $+ \ (acc :: Acc Int) ->+ foldMap (: []) acc ===+ foldMap (: []) (toList acc)+ ,+ testProperty "foldMap'" $+ \ (acc :: Acc Int) ->+ foldMap' (: []) acc ===+ foldMap' (: []) (toList acc)+ ]++instance Arbitrary a => Arbitrary (Acc a) where+ arbitrary =+ accGen arbitrary++accGen :: Gen a -> Gen (Acc a)+accGen aGen =+ oneof [+ listAccGen aGen,+ appendAccGen aGen,+ pureAccGen aGen+ ]++listAccGen :: Gen a -> Gen (Acc a)+listAccGen aGen =+ fromList <$> listOf aGen++appendAccGen :: Gen a -> Gen (Acc a)+appendAccGen aGen =+ (<>) <$> accGen aGen <*> accGen aGen++pureAccGen :: Gen a -> Gen (Acc a)+pureAccGen aGen =+ pure <$> aGen