dlist-0.8.0.4/0000755000000000000000000000000013230370021011155 5ustar0000000000000000dlist-0.8.0.4/dlist.cabal0000644000000000000000000000360413230370021013263 0ustar0000000000000000name: dlist version: 0.8.0.4 synopsis: Difference lists description: Difference lists are a list-like type supporting O(1) append. This is particularly useful for efficient logging and pretty printing (e.g. with the Writer monad), where list append quickly becomes too expensive. category: Data license: BSD3 license-file: LICENSE author: Don Stewart maintainer: Sean Leather copyright: 2006-2009 Don Stewart, 2013-2016 Sean Leather homepage: https://github.com/spl/dlist bug-reports: https://github.com/spl/dlist/issues extra-source-files: README.md, ChangeLog.md build-type: Simple cabal-version: >= 1.9.2 tested-with: GHC==7.0.4 GHC==7.2.2 GHC==7.4.2 GHC==7.6.3 GHC==7.8.4 GHC==7.10.3 GHC==8.0.1 source-repository head type: git location: git://github.com/spl/dlist.git library build-depends: base >= 4 && < 5, deepseq >= 1.1 && < 2 extensions: CPP exposed-modules: Data.DList ghc-options: -Wall test-suite test type: exitcode-stdio-1.0 main-is: Main.hs other-modules: OverloadedStrings hs-source-dirs: tests build-depends: dlist, base, Cabal, -- QuickCheck-2.10 is the first version supporting -- base-4.9 (ghc-8) without the Arbitrary NonEmpty -- instance, which we include ourselves. QuickCheck >= 2.10 && < 2.12 dlist-0.8.0.4/ChangeLog.md0000644000000000000000000000774413230370021013342 0ustar0000000000000000 Change Log ========== Version 0.8.0.4 (2018-01-19) *Kokborok Day* ------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.11 to 2.12 * Make `Data.DList` trustworthy ([Bertram Felgenhauer](https://github.com/int-e)) * Remove quickcheck-instances dependency for tests Version 0.8.0.3 (2017-07-04) *Independence Day in the United States* -------------------------------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.10 to 2.11 and import the `Arbitrary` `NonEmpty` instance from quickcheck-instances for 2.10 * Fix `stimes` property in test suite ([Oleg Grenrus](https://github.com/phadej)) Version 0.8.0.2 (2016-09-04) *World Sexual Health Day* ------------------------------------------------------ #### Package changes * Fix test suite: add missing module `OverloadedStrings` ([Sergei Trofimovich](https://github.com/trofi)) Version 0.8.0.1 (2016-07-29) *58th Anniversary of the Creation of NASA* ----------------------------------------------------------------------- #### Package changes * Change QuickCheck lower bound to 2.9 for GHC >= 8 (base >= 4.9) ([Adam Bergmark](https://github.com/bergmark)) Version 0.8 (2016-07-17) *Constitution Day in South Korea* ---------------------------------------------------------- #### New features * Add pattern synonyms `Nil` and `Cons` for GHC >= 7.8 * Add `Semigroup` instance for GHC >= 8 (base >= 4.9) * Use inflexible instance for `IsString` to improve support for overloaded strings ([Baldur Blöndal](https://github.com/Icelandjack)) #### Package changes * Change QuickCheck upper bound from 2.9 to 2.10 #### Development changes * Add `-Wall -Werror` testing * Add testing for GHC 8.0.1 to Travis-CI Version 0.7.1.2 (2015-08-23) *International Day for the Remembrance of the Slave Trade and its Abolition* --------------------------------------------------------------------------------------------------------- #### Package changes * Fix GHC 7.10 warnings due to imports ([Mikhail Glushenkov](https://github.com/23Skidoo)) Version 0.7.1.1 (2015-03-19) *St. Joseph's Day* ---------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.8 to 2.9 Version 0.7.1 (2014-06-28) *100th Anniversary of the Assassination of Franz Ferdinand* -------------------------------------------------------------------------------------- #### New features * Add `IsList` instance for GHC >= 7.8 ([Baldur Blöndal](https://github.com/Icelandjack)) Version 0.7.0.1 (2014-03-24) *World Tuberculosis Day* ----------------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.7 to 2.8 Version 0.7 (2014-03-17) *St. Patrick's Day* -------------------------------------------- #### New features * Add `NFData` instance (and `deepseq` dependency) * Add `IsString` instance * Remove deprecated entities Version 0.6.0.1 (2013-12-01) *World AIDS Day* --------------------------------------------- #### Package changes * Change QuickCheck lower bound from 2.6 to 2.5 ([Michael Snoyman](https://github.com/snoyberg)) Version 0.6 (2013-11-29) *Black Friday* --------------------------------------- #### Development changes * Maintenance and development taken over by Sean Leather ([Bas van Dijk](https://github.com/basvandijk)) * Migrate repository from http://code.haskell.org/~dons/code/dlist/ to https://github.com/spl/dlist * Add Travis-CI ([Herbert Valerio Riedel](https://github.com/hvr)) #### Package changes * Stop supporting `base < 2` * Fix tests and use `cabal test` * Add scripts for running `hpc` * Update documentation #### New features * New type class instances: `Eq`, `Ord`, `Read`, `Show`, `Alternative`, and `Foldable` * New function `apply` to use instead of `unDL` #### Deprecations * Deprecate `DList` constructor and record selector to make it abstract (see [#4](https://github.com/spl/dlist/issues/4)) * Deprecate `maybeReturn` which is not directly relevant to dlists dlist-0.8.0.4/README.md0000644000000000000000000000500113230370021012430 0ustar0000000000000000# Difference Lists in Haskell [![Hackage](https://img.shields.io/hackage/v/dlist.svg?maxAge=3600)](https://hackage.haskell.org/package/dlist "dlist on Hackage") [![Hackage dependencies](https://img.shields.io/hackage-deps/v/dlist.svg?maxAge=3600)](http://packdeps.haskellers.com/feed?needle=dlist "dlist updated Hackage dependencies") [![Travis CI](https://img.shields.io/travis/spl/dlist.svg?maxAge=3600)](https://travis-ci.org/spl/dlist "dlist build history on Travis CI") ## Summary The Haskell `dlist` package defines a list-like type supporting O(1) append and snoc operations. See [ChangeLog.md](./ChangeLog.md) for recent changes. ## References ### Research 1. A novel representation of lists and its application to the function “reverse.” John Hughes. Information Processing Letters. Volume 22, Issue 3. 1986-03. Pages 141-144. [[PDF](http://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/lists.pdf)] This is the original source for a representation of lists as first-class functions. ### Basic Introduction 1. [Difference list](https://en.wikipedia.org/wiki/Difference_list). Wikipedia. 2. [Difference lists](https://wiki.haskell.org/Difference_list). Haskell.org Wiki. 3. [What is a DList?](https://stackoverflow.com/questions/3352418/what-is-a-dlist). Stack Overflow. ### Blogs and Discussion 1. [Using Difference Lists](http://logicaltypes.blogspot.com/2008/08/using-difference-lists.html). Douglas M. Auclair. 2008-08-13. 2. [A Sort of Difference](https://archive.is/20140131124629/http://web.archive.org/web/20080918101635/comonad.com/reader/2008/a-sort-of-difference/). Edward Kmett. 2008-09-18. 3. [Reference for technique wanted](http://thread.gmane.org/gmane.comp.lang.haskell.cafe/82827). Richard O'Keefe, et al. 2010-10-31. 4. [24 Days of Hackage: dlist](https://ocharles.org.uk/blog/posts/2012-12-14-24-days-of-hackage-dlist.html). Oliver Charles. 2012-12-14. 5. [Constructing a list in a Monad](https://www.joachim-breitner.de/blog/620-Constructing_a_list_in_a_Monad). Joachim Breitner. 2013-11-13. 6. [Demystifying DList](http://h2.jaguarpaw.co.uk/posts/demystifying-dlist/). ([On Reddit](https://www.reddit.com/r/haskell/comments/1w5duf/demystifying_dlist/)). Tom Ellis. 2014-01-24. 7. [keepEquals with Difference Lists](http://logicaltypes.blogspot.com/2014/06/keepequals-with-difference-lists.html), Douglas M. Auclair. 2014-06-21. ### Books 1. [Chapter 13. Data Structures](http://book.realworldhaskell.org/read/data-structures.html). Real World Haskell. 2008-12-05. dlist-0.8.0.4/Setup.lhs0000644000000000000000000000011313230370021012760 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMaindlist-0.8.0.4/LICENSE0000644000000000000000000000301413230370021012160 0ustar0000000000000000Copyright (c) 2006-2009 Don Stewart, 2013-2016 Sean Leather All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Don Stewart nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dlist-0.8.0.4/Data/0000755000000000000000000000000013230370021012026 5ustar0000000000000000dlist-0.8.0.4/Data/DList.hs0000644000000000000000000002177513230370021013415 0ustar0000000000000000{-# OPTIONS_GHC -O2 #-} {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} -- For the IsList and IsString instances #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PatternSynonyms #-} -- Mark this module as trustworthy even though we import 'IsList' from GHC.Exts, -- which is marked unsafe. 'IsList' is safe. {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ViewPatterns #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.DList -- Copyright : (c) 2006-2009 Don Stewart, 2013-2016 Sean Leather -- License : See LICENSE file -- -- Maintainer : sean.leather@gmail.com -- Stability : stable -- Portability : portable -- -- Difference lists: a data structure for /O(1)/ append on lists. -- ----------------------------------------------------------------------------- module Data.DList #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800 ( DList(Nil, Cons) #else ( DList #endif -- * Construction , fromList , toList , apply -- * Basic functions , empty , singleton , cons , snoc , append , concat , replicate , list , head , tail , unfoldr , foldr , map #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 -- * Pattern Synonyms , pattern Nil , pattern Cons #endif ) where import Prelude hiding (concat, foldr, map, head, tail, replicate) import qualified Data.List as List import Control.DeepSeq (NFData(..)) import Control.Monad as M import Data.Function (on) import Data.String (IsString(..)) import qualified Data.Foldable as F #if !MIN_VERSION_base(4,8,0) import Data.Monoid import Data.Foldable (Foldable) import Control.Applicative(Applicative(..)) #endif #if MIN_VERSION_base(4,9,0) import Data.Semigroup (Semigroup(..)) #endif #ifdef __GLASGOW_HASKELL__ import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) #if __GLASGOW_HASKELL__ >= 708 import GHC.Exts (IsList) -- Make IsList type and methods visible for instance. import qualified GHC.Exts (IsList(Item, fromList, toList)) #endif #endif import Control.Applicative(Alternative, (<|>)) import qualified Control.Applicative (empty) -- | A difference list is a function that, given a list, returns the original -- contents of the difference list prepended to the given list. -- -- This structure supports /O(1)/ append and snoc operations on lists, making it -- very useful for append-heavy uses (esp. left-nested uses of 'List.++'), such -- as logging and pretty printing. -- -- Here is an example using DList as the state type when printing a tree with -- the Writer monad: -- -- > import Control.Monad.Writer -- > import Data.DList -- > -- > data Tree a = Leaf a | Branch (Tree a) (Tree a) -- > -- > flatten_writer :: Tree x -> DList x -- > flatten_writer = snd . runWriter . flatten -- > where -- > flatten (Leaf x) = tell (singleton x) -- > flatten (Branch x y) = flatten x >> flatten y -- newtype DList a = DL { unDL :: [a] -> [a] } -- | Convert a list to a dlist fromList :: [a] -> DList a fromList = DL . (++) {-# INLINE fromList #-} -- | Convert a dlist to a list toList :: DList a -> [a] toList = ($[]) . unDL {-# INLINE toList #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- | A unidirectional pattern synonym using 'toList' in a view pattern and -- matching on @[]@ #if __GLASGOW_HASKELL__ >= 710 pattern Nil :: DList a #endif pattern Nil <- (toList -> []) -- | A unidirectional pattern synonym using 'toList' in a view pattern and -- matching on @x:xs@ such that you have the pattern @Cons x xs@ #if __GLASGOW_HASKELL__ >= 710 pattern Cons :: a -> [a] -> DList a #endif pattern Cons x xs <- (toList -> x:xs) #endif -- | Apply a dlist to a list to get the underlying list with an extension -- -- > apply (fromList xs) ys = xs ++ ys apply :: DList a -> [a] -> [a] apply = unDL -- | Create a dlist containing no elements empty :: DList a empty = DL id {-# INLINE empty #-} -- | Create dlist with a single element singleton :: a -> DList a singleton = DL . (:) {-# INLINE singleton #-} -- | /O(1)/. Prepend a single element to a dlist infixr `cons` cons :: a -> DList a -> DList a cons x xs = DL ((x:) . unDL xs) {-# INLINE cons #-} -- | /O(1)/. Append a single element to a dlist infixl `snoc` snoc :: DList a -> a -> DList a snoc xs x = DL (unDL xs . (x:)) {-# INLINE snoc #-} -- | /O(1)/. Append dlists append :: DList a -> DList a -> DList a append xs ys = DL (unDL xs . unDL ys) {-# INLINE append #-} -- | /O(spine)/. Concatenate dlists concat :: [DList a] -> DList a concat = List.foldr append empty {-# INLINE concat #-} -- | /O(n)/. Create a dlist of the given number of elements replicate :: Int -> a -> DList a replicate n x = DL $ \xs -> let go m | m <= 0 = xs | otherwise = x : go (m-1) in go n {-# INLINE replicate #-} -- | /O(n)/. List elimination for dlists list :: b -> (a -> DList a -> b) -> DList a -> b list nill consit dl = case toList dl of [] -> nill (x : xs) -> consit x (fromList xs) -- | /O(n)/. Return the head of the dlist head :: DList a -> a head = list (error "Data.DList.head: empty dlist") const -- | /O(n)/. Return the tail of the dlist tail :: DList a -> DList a tail = list (error "Data.DList.tail: empty dlist") (flip const) -- | /O(n)/. Unfoldr for dlists unfoldr :: (b -> Maybe (a, b)) -> b -> DList a unfoldr pf b = case pf b of Nothing -> empty Just (a, b') -> cons a (unfoldr pf b') -- | /O(n)/. Foldr over difference lists foldr :: (a -> b -> b) -> b -> DList a -> b foldr f b = List.foldr f b . toList {-# INLINE foldr #-} -- | /O(n)/. Map over difference lists. map :: (a -> b) -> DList a -> DList b map f = foldr (cons . f) empty {-# INLINE map #-} instance Eq a => Eq (DList a) where (==) = (==) `on` toList instance Ord a => Ord (DList a) where compare = compare `on` toList -- The Read and Show instances were adapted from Data.Sequence. instance Read a => Read (DList a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP dl <- readPrec return (fromList dl) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \r -> do ("fromList", s) <- lex r (dl, t) <- reads s return (fromList dl, t) #endif instance Show a => Show (DList a) where showsPrec p dl = showParen (p > 10) $ showString "fromList " . shows (toList dl) instance Monoid (DList a) where mempty = empty mappend = append instance Functor DList where fmap = map {-# INLINE fmap #-} instance Applicative DList where pure = singleton {-# INLINE pure #-} (<*>) = ap instance Alternative DList where empty = empty (<|>) = append instance Monad DList where m >>= k -- = concat (toList (fmap k m)) -- = (concat . toList . fromList . List.map k . toList) m -- = concat . List.map k . toList $ m -- = List.foldr append empty . List.map k . toList $ m -- = List.foldr (append . k) empty . toList $ m = foldr (append . k) empty m {-# INLINE (>>=) #-} return = pure {-# INLINE return #-} fail _ = empty {-# INLINE fail #-} instance MonadPlus DList where mzero = empty mplus = append instance Foldable DList where fold = mconcat . toList {-# INLINE fold #-} foldMap f = F.foldMap f . toList {-# INLINE foldMap #-} foldr f x = List.foldr f x . toList {-# INLINE foldr #-} foldl f x = List.foldl f x . toList {-# INLINE foldl #-} foldr1 f = List.foldr1 f . toList {-# INLINE foldr1 #-} foldl1 f = List.foldl1 f . toList {-# INLINE foldl1 #-} -- CPP: foldl', foldr' added to Foldable in 7.6.1 -- http://www.haskell.org/ghc/docs/7.6.1/html/users_guide/release-7-6-1.html #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 foldl' f x = List.foldl' f x . toList {-# INLINE foldl' #-} foldr' f x = F.foldr' f x . toList {-# INLINE foldr' #-} #endif instance NFData a => NFData (DList a) where rnf = rnf . toList {-# INLINE rnf #-} -- This is _not_ a flexible instance to allow certain uses of overloaded -- strings. See tests/OverloadedStrings.hs for an example and -- https://git.haskell.org/ghc.git/commitdiff/b225b234a6b11e42fef433dcd5d2a38bb4b466bf -- for the same change made to the IsString instance for lists. instance a ~ Char => IsString (DList a) where fromString = fromList {-# INLINE fromString #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 instance IsList (DList a) where type Item (DList a) = a fromList = fromList {-# INLINE fromList #-} toList = toList {-# INLINE toList #-} #endif #if MIN_VERSION_base(4,9,0) instance Semigroup (DList a) where (<>) = append {-# INLINE (<>) #-} stimes n x | n < 0 = error "Data.DList.stimes: negative multiplier" | otherwise = rep n where rep 0 = empty rep i = x <> rep (pred i) #endif dlist-0.8.0.4/tests/0000755000000000000000000000000013230370021012317 5ustar0000000000000000dlist-0.8.0.4/tests/Main.hs0000644000000000000000000001420713230370021013543 0ustar0000000000000000{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE OverloadedLists #-} -- For the IsList test #if __GLASGOW_HASKELL__ == 708 {-# LANGUAGE PatternSynonyms #-} -- For pattern synonym use only in GHC 7.8 #endif #endif -------------------------------------------------------------------------------- module Main (main) where -------------------------------------------------------------------------------- import Prelude hiding (concat, foldr, head, map, replicate, tail) import qualified Data.List as List import Test.QuickCheck import Text.Show.Functions () import Data.DList import OverloadedStrings (testOverloadedStrings) #if MIN_VERSION_base(4,9,0) -- base-4.9 introduced Semigroup and NonEmpty. import Control.Applicative (liftA2) -- Arbitrary1 NonEmpty instance import Data.Maybe (mapMaybe) -- Arbitrary1 NonEmpty instance import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import Data.Semigroup (Semigroup(..)) #endif -------------------------------------------------------------------------------- eqWith :: Eq b => (a -> b) -> (a -> b) -> a -> Bool eqWith f g x = f x == g x eqOn :: Eq b => (a -> Bool) -> (a -> b) -> (a -> b) -> a -> Property eqOn c f g x = c x ==> f x == g x -------------------------------------------------------------------------------- prop_model :: [Int] -> Bool prop_model = eqWith id (toList . fromList) prop_empty :: Bool prop_empty = ([] :: [Int]) == (toList empty :: [Int]) prop_singleton :: Int -> Bool prop_singleton = eqWith (:[]) (toList . singleton) prop_cons :: Int -> [Int] -> Bool prop_cons c = eqWith (c:) (toList . cons c . fromList) prop_snoc :: [Int] -> Int -> Bool prop_snoc xs c = xs ++ [c] == toList (snoc (fromList xs) c) prop_append :: [Int] -> [Int] -> Bool prop_append xs ys = xs ++ ys == toList (fromList xs `append` fromList ys) prop_concat :: [[Int]] -> Bool prop_concat = eqWith List.concat (toList . concat . List.map fromList) -- The condition reduces the size of replications and thus the eval time. prop_replicate :: Int -> Int -> Property prop_replicate n = eqOn (const (n < 100)) (List.replicate n) (toList . replicate n) prop_head :: [Int] -> Property prop_head = eqOn (not . null) List.head (head . fromList) prop_tail :: [Int] -> Property prop_tail = eqOn (not . null) List.tail (toList . tail . fromList) prop_unfoldr :: (Int -> Maybe (Int, Int)) -> Int -> Int -> Property prop_unfoldr f n = eqOn (const (n >= 0)) (take n . List.unfoldr f) (take n . toList . unfoldr f) prop_foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Bool prop_foldr f x = eqWith (List.foldr f x) (foldr f x . fromList) prop_map :: (Int -> Int) -> [Int] -> Bool prop_map f = eqWith (List.map f) (toList . map f . fromList) prop_map_fusion :: (Int -> Int) -> (a -> Int) -> [a] -> Bool prop_map_fusion f g = eqWith (List.map f . List.map g) (toList . map f . map g . fromList) prop_show_read :: [Int] -> Bool prop_show_read = eqWith id (read . show) prop_read_show :: [Int] -> Bool prop_read_show x = eqWith id (show . f . read) $ "fromList " ++ show x where f :: DList Int -> DList Int f = id #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- | Test that the IsList instance methods compile and work with simple lists prop_IsList :: Bool prop_IsList = test_fromList [1,2,3] && test_toList (fromList [1,2,3]) where test_fromList, test_toList :: DList Int -> Bool test_fromList x = x == fromList [1,2,3] test_toList [1,2,3] = True test_toList _ = False prop_patterns :: [Int] -> Bool prop_patterns xs = case fromList xs of Nil -> xs == [] Cons y ys -> xs == (y:ys) _ -> False #endif #if MIN_VERSION_base(4,9,0) prop_Semigroup_append :: [Int] -> [Int] -> Bool prop_Semigroup_append xs ys = xs <> ys == toList (fromList xs <> fromList ys) -- We include the instances for NonEmpty because QuickCheck (>= 2.10) does not. -- We could alternatively depend on quickcheck-instances (>= 0.3.15), but -- quickcheck-instances has sometimes lagged behind newer GHC/base versions. By -- including the instances here, we do not need to track the -- quickcheck-instances version, thus simplifying dlist.cabal and reducing the -- maintenance effort. instance Arbitrary1 NonEmpty where liftArbitrary arb = liftA2 (:|) arb (liftArbitrary arb) liftShrink shr (x :| xs) = mapMaybe nonEmpty . liftShrink shr $ x : xs instance Arbitrary a => Arbitrary (NonEmpty a) where arbitrary = arbitrary1 shrink = shrink1 prop_Semigroup_sconcat :: NonEmpty [Int] -> Bool prop_Semigroup_sconcat xs = sconcat xs == toList (sconcat (fmap fromList xs)) prop_Semigroup_stimes :: Int -> [Int] -> Bool prop_Semigroup_stimes n xs = n < 0 || stimes n xs == toList (stimes n (fromList xs)) #endif -------------------------------------------------------------------------------- props :: [(String, Property)] props = [ ("model", property prop_model) , ("empty", property prop_empty) , ("singleton", property prop_singleton) , ("cons", property prop_cons) , ("snoc", property prop_snoc) , ("append", property prop_append) , ("concat", property prop_concat) , ("replicate", property prop_replicate) , ("head", property prop_head) , ("tail", property prop_tail) , ("unfoldr", property prop_unfoldr) , ("foldr", property prop_foldr) , ("map", property prop_map) , ("map fusion", property (prop_map_fusion (+1) (+1))) , ("read . show", property prop_show_read) , ("show . read", property prop_read_show) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 , ("IsList", property prop_IsList) , ("patterns", property prop_patterns) #endif #if MIN_VERSION_base(4,9,0) , ("Semigroup <>", property prop_Semigroup_append) , ("Semigroup sconcat", property prop_Semigroup_sconcat) , ("Semigroup stimes", property prop_Semigroup_stimes) #endif ] -------------------------------------------------------------------------------- main :: IO () main = do testOverloadedStrings quickCheck $ conjoin $ List.map (uncurry label) props dlist-0.8.0.4/tests/OverloadedStrings.hs0000644000000000000000000000032713230370021016313 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module OverloadedStrings (testOverloadedStrings) where import Data.DList testOverloadedStrings :: IO () testOverloadedStrings = print $ "OverloadedStrings:" `append` " success"