diff --git a/Data/DList.hs b/Data/DList.hs --- a/Data/DList.hs +++ b/Data/DList.hs @@ -1,192 +1,94 @@ ------------------------------------------------------------------------------ --- | --- Module : Data.DList --- Copyright : (c) Don Stewart 2006-2007 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : dons@cse.unsw.edu.au --- Stability : experimental --- Portability : portable (Haskell 98) --- --- Difference lists: a data structure for O(1) append on lists. --- ------------------------------------------------------------------------------ - -module Data.DList ( - - DList(..) -- abstract, instance Monoid, Functor, Applicative, Monad, MonadPlus - - -- * Construction - ,fromList -- :: [a] -> DList a - ,toList -- :: DList a -> [a] - - -- * Basic functions - ,empty -- :: DList a - ,singleton -- :: a -> DList a - ,cons -- :: a -> DList a -> DList a - ,snoc -- :: DList a -> a -> DList a - ,append -- :: DList a -> DList a -> DList a - ,concat -- :: [DList a] -> DList a - ,replicate -- :: Int -> a -> DList a - ,list -- :: b -> (a -> DList a -> b) -> DList a -> b - ,head -- :: DList a -> a - ,tail -- :: DList a -> DList a - ,unfoldr -- :: (b -> Maybe (a, b)) -> b -> DList a - ,foldr -- :: (a -> b -> b) -> b -> DList a -> b - ,map -- :: (a -> b) -> DList a -> DList b - - -- * MonadPlus - , maybeReturn - - ) where - -import Prelude hiding (concat, foldr, map, head, tail, replicate) -import qualified Data.List as List -import Control.Monad -import Data.Monoid +{- ORMOLU_DISABLE -} +{-# LANGUAGE CPP #-} -#ifdef APPLICATIVE_IN_BASE -import Control.Applicative(Applicative(..)) +-- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list +#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 +{-# LANGUAGE PatternSynonyms #-} #endif --- | A difference list is a function that given a list, returns the --- original contents of the difference list prepended at the given list --- --- This structure supports /O(1)/ append and snoc operations on lists, --- making it very useful for append-heavy uses, such as logging and --- pretty printing. --- --- For 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] } - --- | Converting a normal list to a dlist -fromList :: [a] -> DList a -fromList = DL . (++) -{-# INLINE fromList #-} - --- | Converting a dlist back to a normal list -toList :: DList a -> [a] -toList = ($[]) . unDL -{-# INLINE toList #-} - --- | Create a difference list containing no elements -empty :: DList a -empty = DL id -{-# INLINE empty #-} - --- | Create difference list with given single element -singleton :: a -> DList a -singleton = DL . (:) -{-# INLINE singleton #-} +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{- --- | /O(1)/, Prepend a single element to a difference list -infixr `cons` -cons :: a -> DList a -> DList a -cons x xs = DL ((x:) . unDL xs) -{-# INLINE cons #-} +The 'Data.DList' module imports the unsafe module 'Data.DList.Internal' but +exports only its safe aspects. Specifically, it does not export the 'DList' +constructor 'UnsafeDList' or record label 'unsafeApplyDList'. Therefore, we mark +'Data.DList' as trustworthy. --- | /O(1)/, Append a single element at a difference list -infixl `snoc` -snoc :: DList a -> a -> DList a -snoc xs x = DL (unDL xs . (x:)) -{-# INLINE snoc #-} +-} +{-# LANGUAGE Trustworthy #-} +#endif --- | /O(1)/, Appending difference lists -append :: DList a -> DList a -> DList a -append xs ys = DL (unDL xs . unDL ys) -{-# INLINE append #-} +----------------------------------------------------------------------------- --- | /O(spine)/, Concatenate difference lists -concat :: [DList a] -> DList a -concat = List.foldr append empty -{-# INLINE concat #-} +{-| --- | /O(n)/, Create a difference list 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 #-} +Module: Data.DList +Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather +License: BSD-3-Clause --- | /O(length dl)/, List elimination, head, tail. -list :: b -> (a -> DList a -> b) -> DList a -> b -list nill consit dl = - case toList dl of - [] -> nill - (x : xs) -> consit x (fromList xs) +Maintainer: sean.leather@gmail.com +Stability: stable --- | Return the head of the list -head :: DList a -> a -head = list (error "Data.DList.head: empty list") const +A __difference list__ is an abstraction representing a list that +supports \(\mathcal{O}\)(@1@) 'append' and 'snoc' operations. This module +provides the type for a difference list, 'DList', and a collection of supporting +functions for (a) converting to and from lists and (b) operating on 'DList's +efficiently. --- | Return the tail of the list -tail :: DList a -> DList a -tail = list (error "Data.DList.tail: empty list") (flip const) +-} +{- ORMOLU_ENABLE -} --- | Unfoldr for difference lists -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') +module Data.DList + ( -- * Difference List Type --- | Foldr over difference lists -foldr :: (a -> b -> b) -> b -> DList a -> b -foldr f b = List.foldr f b . toList -{-# INLINE foldr #-} +-- CPP: GHC >= 8 for pattern synonyms allowed in the constructor +#if __GLASGOW_HASKELL__ >= 800 + DList (Nil, Cons), +#else + DList, --- | Map over difference lists. -map :: (a -> b) -> DList a -> DList b -map f = foldr (cons . f) empty -{-# INLINE map #-} +-- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list +#if __GLASGOW_HASKELL__ >= 708 + -- ** Bundled Patterns + pattern Nil, + pattern Cons, +#endif -instance Monoid (DList a) where - mempty = empty - mappend = append +#endif -instance Functor DList where - fmap = map - {-# INLINE fmap #-} + -- * Conversion + fromList, + toList, + apply, -#ifdef APPLICATIVE_IN_BASE -instance Applicative DList where - pure = return - (<*>) = ap -#endif + -- * Basic Functions + empty, + singleton, + cons, + snoc, + append, + concat, + replicate, + head, + tail, + unfoldr, + foldr, + map, + intercalate, + ) +where -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 x = singleton x - {-# INLINE return #-} +import Data.DList.Internal - fail _ = empty - {-# INLINE fail #-} +{- ORMOLU_DISABLE -} +{- -instance MonadPlus DList where - mzero = empty - mplus = append +The 'Data.DList' module exists only to export names from 'Data.DList.Internal'. +Some names conflict with 'Prelude', so we hide all imports from 'Prelude'. --- Use this to convert Maybe a into DList a, or indeed into any other MonadPlus instance. -maybeReturn :: MonadPlus m => Maybe a -> m a -maybeReturn = maybe mzero return +-} +{- ORMOLU_ENABLE -} +import Prelude () diff --git a/Data/DList/DNonEmpty.hs b/Data/DList/DNonEmpty.hs new file mode 100644 --- /dev/null +++ b/Data/DList/DNonEmpty.hs @@ -0,0 +1,80 @@ +{- ORMOLU_DISABLE -} +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif + +----------------------------------------------------------------------------- + +-- CPP: Ignore unused imports when Haddock is run +#if defined(__HADDOCK_VERSION__) +{-# OPTIONS_GHC -Wno-unused-imports #-} +#endif + +----------------------------------------------------------------------------- + +{-| + +Module: Data.DList.DNonEmpty +Copyright: © 2017-2020 Oleg Grenrus, 2020 Sean Leather +License: BSD-3-Clause + +Maintainer: sean.leather@gmail.com +Stability: stable + +A __non-empty difference list__ is a difference list paired with a 'head' +element. Like the difference list, it supports \(\mathcal{O}\)(@1@) +'append' and 'snoc' operations. + +This module provides the type for a non-empty difference list, 'DNonEmpty', and +a collection of supporting functions for (a) converting to and from 'NonEmpty' +and 'DList' and (b) operating efficiently on 'DNonEmpty' values. The functions +also retain the non-strict semantics of 'NonEmpty'. + +-} +{- ORMOLU_ENABLE -} + +module Data.DList.DNonEmpty + ( -- * Non-Empty Difference List Type + DNonEmpty((:|)), + + -- * Conversion + fromNonEmpty, + toNonEmpty, + toList, + fromList, + + -- * Basic Functions + singleton, + cons, + snoc, + append, + head, + tail, + unfoldr, + map, + ) +where + +----------------------------------------------------------------------------- + +import Data.DList.DNonEmpty.Internal + +-- CPP: Import only for Haddock +#if defined(__HADDOCK_VERSION__) +import Data.List.NonEmpty (NonEmpty) +import Data.DList (DList) +#endif + +{- ORMOLU_DISABLE -} +{- + +The 'Data.DList.DNonEmpty' module exists only to export names from +'Data.DList.DNonEmpty.Internal'. Some names conflict with 'Prelude', so we hide +all imports from 'Prelude'. + +-} +{- ORMOLU_ENABLE -} +import Prelude () diff --git a/Data/DList/DNonEmpty/Internal.hs b/Data/DList/DNonEmpty/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/DList/DNonEmpty/Internal.hs @@ -0,0 +1,474 @@ +{- ORMOLU_DISABLE -} +-- Options passed to GHC +{-# OPTIONS_GHC -O2 #-} +-- Options passed to Haddock +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{- + +This module imports the unsafe module 'GHC.Exts' for 'IsList' but does not use +any unsafe features. Therefore, we mark the module as trustworthy. + +-} +{-# LANGUAGE Trustworthy #-} +#endif + +-- For the IsList and IsString instances +{-# LANGUAGE TypeFamilies #-} + +----------------------------------------------------------------------------- + +{-| + +Module: Data.DList.DNonEmpty.Internal +Copyright: © 2017-2020 Oleg Grenrus, 2020 Sean Leather +License: BSD-3-Clause + +Maintainer: sean.leather@gmail.com +Stability: stable + +This module includes everything related to 'DNonEmpty' and is not exposed to +users of the @dlist@ package. + +-} +{- ORMOLU_ENABLE -} + +module Data.DList.DNonEmpty.Internal where + +----------------------------------------------------------------------------- + +import qualified Control.Applicative as Applicative +import Control.DeepSeq (NFData (..)) +import qualified Control.Monad as Monad +import Data.DList (DList) +import qualified Data.DList as DList +import qualified Data.Foldable as Foldable +import Data.Function (on) +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Semigroup as Semigroup +import Data.String (IsString (..)) +import qualified GHC.Exts as Exts +import qualified Text.Read as Read +import Prelude hiding (head, map, tail) + +----------------------------------------------------------------------------- + +{- ORMOLU_DISABLE -} +{-| + +A non-empty difference list is a pair of a 'head' element and a (possibly empty) +difference list. + +Just as 'DList' is a representation of a list, so is @DNonEmpty@ a +representation of a 'NonEmpty'. @DNonEmpty@ supports \(\mathcal{O}\)(@1@) +'append' and 'snoc' operations, making it useful for replacing frequent +applications of 'Semigroup.<>' on 'NonEmpty' (which is implemented with '++'), +especially if those uses are left-nested (e.g. @(a __'Semigroup.<>'__ b) +'Semigroup.<>' c@ ). + +Unlike 'DList', @DNonEmpty@ is not an abstract type: its constructor is +exported. An alternative definition of @DNonEmpty@ is: + +@ +newtype DNonEmpty a = DNonEmpty ([a] -> 'NonEmpty' a) +@ + +This type would need to be abstract to avoid producing @DNonEmpty@ values that +are not isomorphic to 'NonEmpty' values. However, this type would also require +some functions (such as 'map') to be implemented with 'fromNonEmpty' (and thus +'++'), which could introduce efficiencies. + +-} +{- ORMOLU_ENABLE -} + +infixr 5 :| + +data DNonEmpty a = a :| DList a + +{- ORMOLU_DISABLE -} +{-| + +__@fromNonEmpty xs@__ is a 'DNonEmpty' representing the 'NonEmpty' __@xs@__. + +@fromNonEmpty@ obeys the laws: + +@ +'toNonEmpty' . __fromNonEmpty__ = 'id' +__fromNonEmpty__ . 'toNonEmpty' = 'id' +@ + +As with 'DList.fromList', this function is implemented with '++'. Repeated uses +of @fromNonEmpty@ are just as inefficient as repeated uses of '++'. If you find +yourself doing some form of the following (possibly indirectly), you may not be +taking advantage of the 'DNonEmpty' representation and library: + +@ +__fromNonEmpty__ . f . 'toNonEmpty' +@ + +More likely, you will convert from a 'NonEmpty', perform some operation on the +'DNonEmpty', and convert back to a 'NonEmpty': + +@ +'toNonEmpty' . g . __fromNonEmpty__ +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE fromNonEmpty #-} +fromNonEmpty :: NonEmpty a -> DNonEmpty a +fromNonEmpty ~(x NonEmpty.:| xs) = x :| DList.fromList xs + +{- ORMOLU_DISABLE -} +{-| + +__@toNonEmpty xs@__ is the 'NonEmpty' represented by __@xs@__. + +@toNonEmpty@ obeys the laws: + +@ +__toNonEmpty__ . 'fromNonEmpty' = 'id' +'fromNonEmpty' . __toNonEmpty__ = 'id' +@ + +As with 'DList.toList', evaluating @toNonEmpty xs@ may “collapse” the chain of +function composition underlying many 'DList' functions ('DList.append' in +particular) used to construct the 'tail' of @xs@. This may affect any efficiency +you achieved due to laziness in the construction. + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE toNonEmpty #-} +toNonEmpty :: DNonEmpty a -> NonEmpty a +toNonEmpty ~(x :| xs) = x NonEmpty.:| DList.toList xs + +{- ORMOLU_DISABLE -} +{-| + +__@toDList xs@__ is the non-empty 'DList' represented by __@xs@__. + +@toDList@ obeys the law: + +@ +__toDList__ (x ':|' xs) = 'DList.cons' x xs +@ + +Note that this function is used only in this module. + +-} +{- ORMOLU_ENABLE -} + +toDList :: DNonEmpty a -> DList a +toDList ~(x :| xs) = DList.cons x xs + +{- ORMOLU_DISABLE -} +{-| + +__@toList xs@__ is the non-empty list represented by __@xs@__. + +@toList@ obeys the law: + +@ +__toList__ xs = 'NonEmpty.toList' ('toNonEmpty' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE toList #-} +toList :: DNonEmpty a -> [a] +toList = DList.toList . toDList + +{- ORMOLU_DISABLE -} +{-| + +__@fromList xs@__ is a 'DNonEmpty' representing the list __@xs@__. If @xs@ is +empty, an 'error' is raised. + +@fromList@ obeys the law: + +@ +__fromList__ xs = 'fromNonEmpty' ('NonEmpty.fromList' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +fromList :: [a] -> DNonEmpty a +fromList (x : xs) = x :| DList.fromList xs +fromList [] = error "Data.DList.DNonEmpty.fromList: empty list" + +{- ORMOLU_DISABLE -} +{-| + +__@singleton x@__ is a 'DNonEmpty' with the single element __@x@__. + +@singleton@ obeys the law: + +@ +'toNonEmpty' (__singleton__ x) = x 'NonEmpty.:|' [] +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE singleton #-} +singleton :: a -> DNonEmpty a +singleton x = x :| DList.empty + +{- ORMOLU_DISABLE -} +{-| + +__@cons x xs@__ is a 'DNonEmpty' with the 'head' __@x@__ and the 'tail' __@xs@__. + +\(\mathcal{O}\)(@1@). + +@cons@ obeys the law: + +@ +'toNonEmpty' (__cons__ x xs) = 'NonEmpty.cons' x ('toNonEmpty' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +infixr 9 `cons` + +{-# INLINE cons #-} +cons :: a -> DNonEmpty a -> DNonEmpty a +cons x ~(y :| ys) = x :| DList.cons y ys + +infixl 9 `snoc` + +{- ORMOLU_DISABLE -} +{-| + +__@snoc xs x@__ is a 'DNonEmpty' with the initial 'DNonEmpty' __@xs@__ and the +last element __@x@__. + +\(\mathcal{O}\)(@1@). + +@snoc@ obeys the law: + +@ +'toNonEmpty' (__snoc__ xs x) = 'toNonEmpty' xs 'Semigroup.<>' (x 'NonEmpty.:|' []) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE snoc #-} +snoc :: DNonEmpty a -> a -> DNonEmpty a +snoc ~(x :| xs) y = x :| DList.snoc xs y + +{- ORMOLU_DISABLE -} +{-| + +__@append xs ys@__ is a 'DNonEmpty' obtained from the concatenation of the +elements of __@xs@__ and __@ys@__. + +\(\mathcal{O}\)(@1@). + +@append@ obeys the law: + +@ +'toNonEmpty' (__append__ xs ys) = 'toNonEmpty' xs 'Semigroup.<>' 'toNonEmpty' ys +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE append #-} +append :: DNonEmpty a -> DNonEmpty a -> DNonEmpty a +append (x :| xs) ~(y :| ys) = x :| DList.append xs (DList.cons y ys) + +{- ORMOLU_DISABLE -} +{-| + +__@head xs@__ is the first element of __@xs@__. + +\(\mathcal{O}\)(@1@). + +@head@ obeys the law: + +@ +__head__ xs = 'NonEmpty.head' ('toNonEmpty' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE head #-} +head :: DNonEmpty a -> a +head ~(x :| _) = x + +{- ORMOLU_DISABLE -} +{-| + +__@tail xs@__ is a 'DList' of the elements in __@xs@__ excluding the first +element. + +\(\mathcal{O}\)(@1@). + +@tail@ obeys the law: + +@ +'DList.toList' (__tail__ xs) = 'NonEmpty.tail' ('toNonEmpty' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE tail #-} +tail :: DNonEmpty a -> DList a +tail ~(_ :| xs) = xs + +{- ORMOLU_DISABLE -} +{-| + +__@unfoldr f z@__ is the 'DNonEmpty' constructed from the recursive application +of __@f@__. The recursion starts with the seed value __@z@__ and ends when, for +some @z' : b@, @f z' == 'Nothing'@. + +\(\mathcal{O}\)(@'NonEmpty.length' ('NonEmpty.unfoldr' f z)@). + +@unfoldr@ obeys the law: + +@ +'toNonEmpty' (__unfoldr__ f z) = 'NonEmpty.unfoldr' f z +@ + +-} +{- ORMOLU_ENABLE -} + +unfoldr :: (b -> (a, Maybe b)) -> b -> DNonEmpty a +unfoldr f z = + case f z of + (x, Nothing) -> singleton x + (x, Just z') -> cons x $ unfoldr f z' + +{- ORMOLU_DISABLE -} +{-| + +__@map f xs@__ is the 'DNonEmpty' obtained by applying __@f@__ to each element +of __@xs@__. + +\(\mathcal{O}\)(@'NonEmpty.length' ('toNonEmpty' xs)@). + +@map@ obeys the law: + +@ +'toNonEmpty' (__map__ f xs) = 'NonEmpty.map' f ('toNonEmpty' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE map #-} +map :: (a -> b) -> DNonEmpty a -> DNonEmpty b +map f ~(x :| xs) = f x :| DList.map f xs + +instance Eq a => Eq (DNonEmpty a) where + (==) = (==) `on` toNonEmpty + +instance Ord a => Ord (DNonEmpty a) where + compare = compare `on` toNonEmpty + +instance Read a => Read (DNonEmpty a) where + readPrec = Read.parens $ + Read.prec 10 $ do + Read.Ident "fromNonEmpty" <- Read.lexP + dl <- Read.readPrec + return $ fromNonEmpty dl + readListPrec = Read.readListPrecDefault + +instance Show a => Show (DNonEmpty a) where + showsPrec p dl = + showParen (p > 10) $ + showString "fromNonEmpty " . shows (toNonEmpty dl) + +instance Functor DNonEmpty where + {-# INLINE fmap #-} + fmap = map + +instance Applicative.Applicative DNonEmpty where + {-# INLINE pure #-} + pure = singleton + + {-# INLINE (<*>) #-} + (<*>) = Monad.ap + +instance Monad DNonEmpty where + ~(x :| xs) >>= k = y :| DList.append ys (xs >>= toDList . k) + where + y :| ys = k x + + {-# INLINE return #-} + return = Applicative.pure + +instance Foldable.Foldable DNonEmpty where + {-# INLINE fold #-} + fold = Foldable.fold . toNonEmpty + + {-# INLINE foldMap #-} + foldMap f = Foldable.foldMap f . toNonEmpty + + {-# INLINE foldr #-} + foldr f x = Foldable.foldr f x . toNonEmpty + + {-# INLINE foldl #-} + foldl f x = Foldable.foldl f x . toNonEmpty + + {-# INLINE foldr1 #-} + foldr1 f = Foldable.foldr1 f . toNonEmpty + + {-# INLINE foldl1 #-} + foldl1 f = Foldable.foldl1 f . toNonEmpty + + {-# INLINE foldl' #-} + foldl' f x = Foldable.foldl' f x . toNonEmpty + + {-# INLINE foldr' #-} + foldr' f x = Foldable.foldr' f x . toNonEmpty + + {-# INLINE toList #-} + toList = toList + +instance NFData a => NFData (DNonEmpty a) where + {-# INLINE rnf #-} + rnf = rnf . toNonEmpty + +{- + +The 'IsString' instance is _not_ a flexible instance to allow certain uses of +overloaded strings. See tests/OverloadedStrings.hs for an example and +https://gitlab.haskell.org/ghc/ghc/-/commit/b225b234a6b11e42fef433dcd5d2a38bb4b466bf +for the same change made to the IsString instance for lists. + +-} + +instance a ~ Char => IsString (DNonEmpty a) where + {-# INLINE fromString #-} + fromString = fromList + +instance Exts.IsList (DNonEmpty a) where + type Item (DNonEmpty a) = a + + {-# INLINE fromList #-} + fromList = fromList + + {-# INLINE toList #-} + toList = toList + +instance Semigroup.Semigroup (DNonEmpty a) where + {-# INLINE (<>) #-} + (<>) = append diff --git a/Data/DList/Internal.hs b/Data/DList/Internal.hs new file mode 100644 --- /dev/null +++ b/Data/DList/Internal.hs @@ -0,0 +1,676 @@ +{- ORMOLU_DISABLE -} +-- Options passed to GHC +{-# OPTIONS_GHC -O2 #-} +-- Options passed to Haddock +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP #-} + +{- + +We use __GLASGOW_HASKELL__ everywhere, so, rather than check if it's defined in +multiple places, we assert an error here if it is not. Since the rest of the +package depends on this module ('Data.DList.Internal'), we don't perform the +same check everywhere else. + +-} +#if !defined(__GLASGOW_HASKELL__) +#error "Your compiler is not GHC. Let us know if dlist can be made to work on it." +#endif + +-- For the IsList and IsString instances +{-# LANGUAGE TypeFamilies #-} + +-- CPP: GHC >= 7.8 for pattern synonyms, Safe Haskell, view patterns +#if __GLASGOW_HASKELL__ >= 708 +{- ORMOLU_ENABLE -} +{-# LANGUAGE PatternSynonyms #-} +{- + +The 'Data.DList.Internal' module exports 'UnsafeDList' and 'unsafeApplyDList', +which allow breaking the invariant of the 'DList' newtype. Therefore, we +explicitly mark 'Data.DList.Internal' as unsafe. + +-} +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE ViewPatterns #-} +{- ORMOLU_DISABLE -} +#endif + +----------------------------------------------------------------------------- + +{-| + +Module: Data.DList.Internal +Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather +License: BSD-3-Clause + +Maintainer: sean.leather@gmail.com +Stability: stable + +This module includes everything related to 'DList' and is not exposed to users +of the @dlist@ package. + +-} +{- ORMOLU_ENABLE -} + +module Data.DList.Internal where + +----------------------------------------------------------------------------- + +import qualified Control.Applicative as Applicative +import Control.DeepSeq (NFData (..)) +import qualified Control.Monad as Monad +-- CPP: base >= 4.9 for MonadFail +-- CPP: base >= 4.13 for MonadFail exported from Control.Monad +#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0) +import qualified Control.Monad.Fail as Monad +#endif +import qualified Data.Foldable as Foldable +import Data.Function (on) +import qualified Data.List as List +import qualified Data.Monoid as Monoid +-- CPP: base >= 4.9 for Semigroup +#if MIN_VERSION_base(4,9,0) +import qualified Data.Semigroup as Semigroup +#endif +import Data.String (IsString (..)) +import qualified Data.Traversable as Traversable +-- CPP: GHC >= 7.8 for IsList +#if __GLASGOW_HASKELL__ >= 708 +import qualified GHC.Exts as Exts +#endif +import qualified Text.Read as Read +import Prelude hiding (concat, foldr, head, map, replicate, tail) + +----------------------------------------------------------------------------- + +{- ORMOLU_DISABLE -} +{-| + +A difference list is an abstraction representing a list that +supports \(\mathcal{O}\)(@1@) 'append' and 'snoc' operations, making it +useful for replacing frequent applications of '++' such as logging and pretty +printing (esp. if those uses of '++' are left-nested). + +-} +{- ORMOLU_ENABLE -} + +newtype DList a = UnsafeDList {unsafeApplyDList :: [a] -> [a]} + +{- ORMOLU_DISABLE -} +{-| + +__@fromList xs@__ is a 'DList' representing the list __@xs@__. + +@fromList@ obeys the laws: + +@ +'toList' . __fromList__ = 'id' +__fromList__ . 'toList' = 'id' +@ + +This function is implemented with '++'. Repeated uses of @fromList@ are just as +inefficient as repeated uses of '++'. If you find yourself doing some form of +the following (possibly indirectly), you may not be taking advantage of the +'DList' representation and library: + +@ +__fromList__ . f . 'toList' +@ + +More likely, you will convert from a list, perform some operation on the +'DList', and convert back to a list: + +@ +'toList' . g . __fromList__ +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE fromList #-} +fromList :: [a] -> DList a +fromList = UnsafeDList . (++) + +{- ORMOLU_DISABLE -} +{-| + +__@toList xs@__ is the list represented by __@xs@__. + +@toList@ obeys the laws: + +@ +__toList__ . 'fromList' = 'id' +'fromList' . __toList__ = 'id' +@ + +Evaluating @toList xs@ may “collapse” the chain of function composition +underlying many 'DList' functions ('append' in particular) used to construct +@xs@. This may affect any efficiency you achieved due to laziness in the +construction. + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE toList #-} +toList :: DList a -> [a] +toList = ($ []) . unsafeApplyDList + +-- CPP: GHC >= 7.8 for pattern synonyms +#if __GLASGOW_HASKELL__ >= 708 + +-- CPP: GHC >= 7.10 for pattern synonym signatures + +{- ORMOLU_DISABLE -} +{-| + +A unidirectional pattern synonym for 'empty'. This is implemented with 'toList'. + +-} +{- ORMOLU_ENABLE -} + +#if __GLASGOW_HASKELL__ >= 710 +pattern Nil :: DList a +#endif +pattern Nil <- (toList -> []) + +{- ORMOLU_DISABLE -} +{-| + +A unidirectional pattern synonym for 'cons'. This is implemented with 'toList'. + +-} +{- ORMOLU_ENABLE -} + +#if __GLASGOW_HASKELL__ >= 710 +pattern Cons :: a -> [a] -> DList a +#endif +pattern Cons x xs <- (toList -> x : xs) + +#endif + +{- ORMOLU_DISABLE -} +{-| + +__@apply xs ys@__ is the list represented by the __@xs@__ after appending +__@ys@__ to it. + +\(\mathcal{O}\)(@1@). + +@apply@ obeys the law: + +@ +__apply__ xs ys = 'toList' xs '++' ys +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE apply #-} +apply :: DList a -> [a] -> [a] +apply = unsafeApplyDList + +{- ORMOLU_DISABLE -} +{-| + +__@empty@__ is a 'DList' with no elements. + +@empty@ obeys the law: + +@ +'toList' __empty__ = [] +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE empty #-} +empty :: DList a +empty = UnsafeDList id + +{- ORMOLU_DISABLE -} +{-| + +__@singleton x@__ is a 'DList' with the single element __@x@__. + +@singleton@ obeys the law: + +@ +'toList' (__singleton__ x) = [x] +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE singleton #-} +singleton :: a -> DList a +singleton = UnsafeDList . (:) + +{- ORMOLU_DISABLE -} +{-| + +__@cons x xs@__ is a 'DList' with the 'head' __@x@__ and the 'tail' __@xs@__. + +\(\mathcal{O}\)(@1@). + +@cons@ obeys the law: + +@ +'toList' (__cons__ x xs) = x : 'toList' xs +@ + +-} +{- ORMOLU_ENABLE -} + +infixr 9 `cons` + +{-# INLINE cons #-} +cons :: a -> DList a -> DList a +cons x xs = UnsafeDList $ (x :) . unsafeApplyDList xs + +infixl 9 `snoc` + +{- ORMOLU_DISABLE -} +{-| + +__@snoc xs x@__ is a 'DList' with the initial 'DList' __@xs@__ and the last +element __@x@__. + +\(\mathcal{O}\)(@1@). + +@snoc@ obeys the law: + +@ +'toList' (__snoc__ xs x) = 'toList' xs '++' [x] +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE snoc #-} +snoc :: DList a -> a -> DList a +snoc xs x = UnsafeDList $ unsafeApplyDList xs . (x :) + +{- ORMOLU_DISABLE -} +{-| + +__@append xs ys@__ is a 'DList' obtained from the concatenation of the elements +of __@xs@__ and __@ys@__. + +\(\mathcal{O}\)(@1@). + +@append@ obeys the law: + +@ +'toList' (__append__ xs ys) = 'toList' xs '++' 'toList' ys +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE append #-} +append :: DList a -> DList a -> DList a +append xs ys = UnsafeDList $ unsafeApplyDList xs . unsafeApplyDList ys + +{- ORMOLU_DISABLE -} +{-| + +__@concat xss@__ is a 'DList' representing the concatenation of all 'DList's in +the list __@xss@__. + +\(\mathcal{O}\)(@'length' xss@). + +@concat@ obeys the law: + +@ +'toList' (__concat__ xss) = 'List.concat' ('List.map' 'toList' xss) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE concat #-} +concat :: [DList a] -> DList a +concat = List.foldr append empty + +{- ORMOLU_DISABLE -} +{-| + +__@replicate n x@__ is a 'DList' of length __@n@__ with __@x@__ as the value of +every element. + +\(\mathcal{O}\)(@n@). + +@replicate@ obeys the law: + +@ +'toList' (__replicate__ n x) = 'List.replicate' n x +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE replicate #-} +replicate :: Int -> a -> DList a +replicate n x = UnsafeDList $ \xs -> + let go m + | m <= 0 = xs + | otherwise = x : go (m -1) + in go n + +{- ORMOLU_DISABLE -} +{-| + +__@head xs@__ is the first element of __@xs@__. If @xs@ is empty, an 'error' is +raised. + +\(\mathcal{O}\)(@1@). + +@head@ obeys the law: + +@ +__head__ xs = 'List.head' ('toList' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE head #-} +head :: DList a -> a +head xs = case toList xs of + x : _ -> x + [] -> error "Data.DList.head: empty DList" + +{- ORMOLU_DISABLE -} +{-| + +__@tail xs@__ is a list of the elements in __@xs@__ excluding the first element. +If @xs@ is empty, an 'error' is raised. + +\(\mathcal{O}\)(@'length' ('toList' xs)@). + +@tail@ obeys the law: + +@ +__tail__ xs = 'List.tail' ('toList' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE tail #-} +tail :: DList a -> [a] +tail xs = case toList xs of + _ : ys -> ys + [] -> error "Data.DList.tail: empty DList" + +{- ORMOLU_DISABLE -} +{-| + +__@unfoldr f z@__ is the 'DList' constructed from the recursive application of +__@f@__. The recursion starts with the seed value __@z@__ and ends when, for +some @z' : b@, @f z' == 'Nothing'@. + +\(\mathcal{O}\)(@'length' ('List.unfoldr' f z)@). + +@unfoldr@ obeys the law: + +@ +'toList' (__unfoldr__ f z) = 'List.unfoldr' f z +@ + +-} +{- ORMOLU_ENABLE -} + +unfoldr :: (b -> Maybe (a, b)) -> b -> DList a +unfoldr f z = + case f z of + Nothing -> empty + Just (x, z') -> cons x $ unfoldr f z' + +{- ORMOLU_DISABLE -} +{-| + +__@foldr f z xs@__ is the right-fold of __@f@__ over __@xs@__. + +\(\mathcal{O}\)(@'length' ('toList' xs)@). + +@foldr@ obeys the law: + +@ +__foldr__ f z xs = 'List.foldr' f z ('toList' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE foldr #-} +foldr :: (a -> b -> b) -> b -> DList a -> b +foldr f z = List.foldr f z . toList + +{- ORMOLU_DISABLE -} +{-| + +__@map f xs@__ is the 'DList' obtained by applying __@f@__ to each element of +__@xs@__. + +\(\mathcal{O}\)(@'length' ('toList' xs)@). + +@map@ obeys the law: + +@ +'toList' (__map__ f xs) = 'List.map' f ('toList' xs) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE map #-} +map :: (a -> b) -> DList a -> DList b +map f = foldr (cons . f) empty + +{- ORMOLU_DISABLE -} +{-| + +__@intercalate xs xss@__ is the concatenation of __@xss@__ after the insertion +of __@xs@__ between every pair of +elements. + +\(\mathcal{O}\)(@'length' xss@). + +@intercalate@ obeys the law: + +@ +'toList' (__intercalate__ xs xss) = 'List.intercalate' ('toList' xs) ('map' 'toList' xss) +@ + +-} +{- ORMOLU_ENABLE -} + +{-# INLINE intercalate #-} +intercalate :: DList a -> [DList a] -> DList a +intercalate sep = concat . List.intersperse sep + +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 + readPrec = Read.parens $ + Read.prec 10 $ do + Read.Ident "fromList" <- Read.lexP + dl <- Read.readPrec + return (fromList dl) + readListPrec = Read.readListPrecDefault + +instance Show a => Show (DList a) where + showsPrec p dl = + showParen (p > 10) $ + showString "fromList " . shows (toList dl) + +instance Monoid.Monoid (DList a) where + {-# INLINE mempty #-} + mempty = empty + +-- CPP: base >= 4.11 for Semigroup as a superclass of Monoid +#if MIN_VERSION_base(4,11,0) + +#else + + {-# INLINE mappend #-} +-- CPP: base >= 4.9 for Semigroup in base +#if MIN_VERSION_base(4,9,0) + -- Canonical definition + mappend = (Semigroup.<>) +#else + mappend = append +#endif + +#endif + +instance Functor DList where + {-# INLINE fmap #-} + fmap = map + +instance Applicative.Applicative DList where + {-# INLINE pure #-} + pure = singleton + + {-# INLINE (<*>) #-} + (<*>) = Monad.ap + +instance Applicative.Alternative DList where + {-# INLINE empty #-} + empty = empty + + {-# INLINE (<|>) #-} + (<|>) = append + +instance Monad DList where + {-# INLINE (>>=) #-} + 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 #-} + return = Applicative.pure + +-- CPP: base < 4.13 for fail in Monad +#if !MIN_VERSION_base(4,13,0) + {-# INLINE fail #-} + fail _ = empty +#endif + +-- CPP: base >= 4.9 for MonadFail +#if MIN_VERSION_base(4,9,0) +instance Monad.MonadFail DList where + {-# INLINE fail #-} + fail _ = empty +#endif + +instance Monad.MonadPlus DList where + {-# INLINE mzero #-} + mzero = empty + + {-# INLINE mplus #-} + mplus = append + +instance Foldable.Foldable DList where + {-# INLINE fold #-} + fold = Monoid.mconcat . toList + + {-# INLINE foldMap #-} + foldMap f = Foldable.foldMap f . toList + + {-# INLINE foldr #-} + foldr f x = List.foldr f x . toList + + {-# INLINE foldl #-} + foldl f x = List.foldl f x . toList + + {-# INLINE foldr1 #-} + foldr1 f = List.foldr1 f . toList + + {-# INLINE foldl1 #-} + foldl1 f = List.foldl1 f . toList + +-- CPP: GHC >= 7.6 for foldl', foldr' in Foldable +#if __GLASGOW_HASKELL__ >= 706 + {-# INLINE foldl' #-} + foldl' f x = List.foldl' f x . toList + + {-# INLINE foldr' #-} + foldr' f x = Foldable.foldr' f x . toList +#endif + +-- CPP: base >= 4.8 for toList in Foldable +#if MIN_VERSION_base(4,8,0) + {-# INLINE toList #-} + toList = Data.DList.Internal.toList +#endif + +instance Traversable.Traversable DList where + {-# INLINE traverse #-} + traverse f = foldr cons_f (Applicative.pure empty) + where + cons_f x = Applicative.liftA2 cons (f x) + +instance NFData a => NFData (DList a) where + {-# INLINE rnf #-} + rnf = rnf . toList + +{- + +The 'IsString' instance is _not_ a flexible instance to allow certain uses of +overloaded strings. See tests/OverloadedStrings.hs for an example and +https://gitlab.haskell.org/ghc/ghc/-/commit/b225b234a6b11e42fef433dcd5d2a38bb4b466bf +for the same change made to the IsString instance for lists. + +-} + +instance a ~ Char => IsString (DList a) where + {-# INLINE fromString #-} + fromString = fromList + +-- CPP: GHC >= 7.8 for IsList +#if __GLASGOW_HASKELL__ >= 708 +instance Exts.IsList (DList a) where + type Item (DList a) = a + + {-# INLINE fromList #-} + fromList = fromList + + {-# INLINE toList #-} + toList = toList +#endif + +{- + +We use 'compare n 0' in the definition of 'Semigroup.stimes' since the same +expression is used in 'Semigroup.stimesMonoid' and we should get a lazy +advantage. However, we prefer the error to be sourced here instead of +'Semigroup.stimesMonoid'. + +-} + +-- CPP: base >= 4.9 for Semigroup +#if MIN_VERSION_base(4,9,0) +instance Semigroup.Semigroup (DList a) where + {-# INLINE (<>) #-} + (<>) = append + + stimes n = case compare n 0 of + LT -> error "Data.DList.stimes: negative multiplier" + _ -> Semigroup.stimesMonoid n +#endif diff --git a/Data/DList/Unsafe.hs b/Data/DList/Unsafe.hs new file mode 100644 --- /dev/null +++ b/Data/DList/Unsafe.hs @@ -0,0 +1,41 @@ +{- ORMOLU_DISABLE -} +-- Options passed to Haddock +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- + +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{- + +The 'Data.DList.Unsafe' module exports 'UnsafeDList' and 'unsafeApplyDList', +which allow breaking the invariant of the 'DList' newtype. Therefore, we +explicitly mark 'Data.DList.Unsafe' as unsafe. + +-} +{-# LANGUAGE Unsafe #-} +#endif + +----------------------------------------------------------------------------- + +{-| + +Module: Data.DList.Unsafe +Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather +License: BSD-3-Clause + +Maintainer: sean.leather@gmail.com +Stability: stable + +This module exports the 'DList' constructor, 'UnsafeDList', and the record label, +'unsafeApplyDList', both of which can be used to create unsafe 'DList' values +that break the invariant preserved by the names exported from 'Data.DList'. + +-} +{- ORMOLU_ENABLE -} + +module Data.DList.Unsafe (DList (UnsafeDList, unsafeApplyDList)) where + +import Data.DList.Internal diff --git a/LICENSE b/LICENSE deleted file mode 100644 --- a/LICENSE +++ /dev/null @@ -1,31 +0,0 @@ -Copyright Don Stewart 2006. - -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. diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,15 +0,0 @@ -DLists: a Haskell list type supporting O(1) append and snoc - -Build instructions: - - $ runhaskell Setup.lhs configure --prefix=$HOME - $ runhaskell Setup.lhs build - $ runhaskell Setup.lhs install - -Running the testsuite: - $ cd tests && runhaskell Properties.hs - $ cd tests && ghc --make -O2 -ddump-simpl-stats Properties.hs -o prop && ./prop - -Author: - Don Stewart - http://www.cse.unsw.edu.au/~dons diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,340 @@ +# Change Log + +## [Unreleased][] + +_No unreleased changes at this time._ + +## [v1.0][] + +Released on **2020-07-18**, **Nelson Mandela International Day**. + +### Added + +* `intercalate` for `DList` ([#43][], [Jacob Leach][]) +* `Traversable` instance for `DList` ([#45][], [Veronika Romashkina][]) +* `Data.DList.Internal` for the `DList` implementation, `Data.DList.Unsafe` for + exporting the `DList` constructor `UnsafeDList` and record label + `unsafeApplyDList` ([#55][], [#59][]) +* `Data.DList.DNonEmpty` ([#60][]) +* GitHub Action for uploading a release ([#74][]) +* `dlist-bench`, a benchmark package ([#71][]) + +### Changed + +* `stimes` for `DList` defined with `stimesMonoid` ([#46][], [Janek Spaderna][]) +* Type of `tail`: `DList a -> DList a` to `DList a -> [a]` ([#69][]) +* GitHub Action for continuous integration testing to replace Travis-CI + ([#47][], [#50][]) +* GHC warning and error improvements ([#72][], [#73][]) +* Improved documentation ([#55][], [#70][], [#76][], [#77][]) + +### Removed + +* `list :: b -> (a -> DList a -> b) -> DList a -> b` ([#69][]) + +## [v0.8.0.8][] + +Released on **2020-04-02**, **World Autism Awareness Day**. + +### Added + +* `toList` in the `Foldable` instance for `DList` ([#36][], [Ryan Scott][]) + +### Changed + +* `QuickCheck` upper bound: 2.14 to 2.15 ([`a7ea60d`][]) + +### Fixed + +* Documented time complexity of `head` for `DList` ([#35][], [Simon Jakobi][]) + +## [v0.8.0.7][] + +Released on **2019-08-05**, **Independence Day in Burkina Faso**. + +### Added + +* `MonadFail` instance for `DList` ([#32][], [Vanessa McHale][]) + +### Changed + +* `deepseq` upper bound: 2 to 1.5 ([#33][], [Herbert Valerio Riedel][]) + +## [v0.8.0.6][] + +Released on **2019-03-29**, **Martyrs' Day in Madagascar**. + +### Changed + +* `QuickCheck` upper bound: 2.13 to 2.14 ([`242511c`][]) + +## [v0.8.0.5][] + +Released on **2018-09-13**, **Day of the Programmer**. + +### Changed + +* `QuickCheck` upper bound: 2.12 to 2.13 ([`0e2b3a5`][]) + +## [v0.8.0.4][] + +Released on **2018-01-19**, **Kokborok Day**. + +### Added + +* `{-# LANGUAGE Trustworthy #-}` in `Data.DList` ([#31][], [Bertram + Felgenhauer][]) + +### Changed + +* `QuickCheck` upper bound: 2.11 to 2.12 ([`3d9c8ad`][]) +* `QuickCheck` lower bound: 2.7/2.9 to 2.10 ([`4f92012`][]) +* `Arbitrary`, `Arbitrary1` instances for `NonEmpty` in the test suite copied + from `quickcheck-instances` ([`4f92012`][]) + +## [v0.8.0.3][] + +Released on **2017-07-04**, **Independence Day in the United States**. + +### Added + +* `quickcheck-instances` dependency in the test suite for the `Arbitrary`, + `Arbitrary1` instances for `NonEmpty` ([`5b41d0d`][]) + +### Changed + +* `QuickCheck` upper bound: 2.10 to 2.11 ([`b2f791a`][]) + +### Fixed + +* `stimes` property in the test suite ([#30][], [Oleg Grenrus][]) + +## [v0.8.0.2][] + +Released on **2016-09-04**, **World Sexual Health Day**. + +### Fixed + +* Missing module `OverloadedStrings` in the test suite ([#29][], [Sergei + Trofimovich][]) + +## [v0.8.0.1][] + +Released on **2016-07-29**, the **58th Anniversary of the Creation of NASA**. + +### Changed + +* `QuickCheck` lower bound: 2.7 to 2.9 for GHC >= 8 ([#28][], [Adam Bergmark][]) + +## [v0.8][] + +Released on **2016-07-17**, **Constitution Day in South Korea**. + +### Added + +* Pattern synonyms `Nil` and `Cons` ([#15][]) +* `Semigroup` instance for `DList` ([#25][]) +* Canonical `Applicative` and `Monad` instances for `DList` ([#23][], [Herbert + Valerio Riedel][]) + +### Changed + +* `IsString` instance for `DList` is no longer flexible ([#26][], [Baldur + Blöndal][]) +* `QuickCheck` upper bound: 2.9 to 2.10 ([`ef7eac5`][]) + +## [v0.7.1.2][] + +Released on **2015-08-23**, **International Day for the Remembrance of the Slave +Trade and its Abolition**. + +### Fixed + +* Imports causing warnings in GHC 7.10 ([#22][], [Mikhail Glushenkov][]) + +## [v0.7.1.1][] + +Released on **2015-03-19**, **St. Joseph's Day**. + +### Changed + +* `QuickCheck` lower bound: 2.5 to 2.7 ([`2d8ec37`][]) +* `QuickCheck` upper bound: 2.8 to 2.9 ([`3176153`][]) + +## [v0.7.1][] + +Released on **2014-06-28**, the **100th Anniversary of the Assassination of +Franz Ferdinand**. + +### Added + +* `IsList` instance for `DList` ([#13][], [Baldur Blöndal][]) + +## [v0.7.0.1][] + +Released on **2014-03-24**, **World Tuberculosis Day**. + +### Changed + +* `QuickCheck` upper bound: 2.7 to 2.8 ([`7494dbc`][]) + +## [v0.7][] + +Released on **2014-03-17**, **St. Patrick's Day**. + +### Added + +* `NFData` instance for `DList` ([#10][], [Evan Laforge][]) +* `IsString` instance for `DList` ([`771a38d`][]) + +### Changed + +* `base` lower bound: 2 to 4 ([`77f6898`][]) + +### Removed + +* `DList` constructor and record label, `maybeReturn` ([`62c0c09`][]) + +## [v0.6.0.1][] + +Released on **2013-12-01**, **World AIDS Day**. + +### Changed + +* `QuickCheck` lower bound: 2.6 to 2.5 ([#9][], [Michael Snoyman][]) + +## [v0.6][] + +Released on **2013-11-29**, **Black Friday**. + +### Added + +* `apply` to replace `DList` record label `unDL` ([#4][]) +* `Eq`, `Ord`, `Show`, and `Alternative` instances for `DList` ([#1][], [Bas van + Dijk][]) +* `Read` instance for `DList` ([`58ef305`][]) +* `Foldable` instance for `DList` ([`5b1d09f`][]) +* Travis-CI for continuous integration testing ([#6][], [Herbert Valerio + Riedel][]) + +### Changed + +* Maintenance: [Don Stewart][] to [Sean Leather][] ([#2][], [Bas van Dijk][]) +* Repository: `http://code.haskell.org/~dons/code/dlist/` to + `https://github.com/spl/dlist` +* `base` lower bound: 0 to 2 ([`6e1d9e7`][]) + +### Fixed + +* Test suite simplified and changed to use `cabal test` ([`9f58759`][]) + +### Deprecated + +* Exported `DList` constructor and record label, `maybeReturn` ([#4][]) + + + + + +[v0.6]: https://github.com/spl/dlist/compare/v0.5...v0.6 +[v0.6.0.1]: https://github.com/spl/dlist/compare/v0.6...v0.6.0.1 +[v0.7]: https://github.com/spl/dlist/compare/v0.6.0.1...v0.7 +[v0.7.0.1]: https://github.com/spl/dlist/compare/v0.7...v0.7.0.1 +[v0.7.1.1]: https://github.com/spl/dlist/compare/v0.7.1...v0.7.1.1 +[v0.7.1.2]: https://github.com/spl/dlist/compare/v0.7.1.1...v0.7.1.2 +[v0.7.1]: https://github.com/spl/dlist/compare/v0.7.0.1...v0.7.1 +[v0.8]: https://github.com/spl/dlist/compare/v0.7.1.2...v0.8 +[v0.8.0.1]: https://github.com/spl/dlist/compare/v0.8...v0.8.0.1 +[v0.8.0.2]: https://github.com/spl/dlist/compare/v0.8.0.1...v0.8.0.2 +[v0.8.0.3]: https://github.com/spl/dlist/compare/v0.8.0.2...v0.8.0.3 +[v0.8.0.4]: https://github.com/spl/dlist/compare/v0.8.0.3...v0.8.0.4 +[v0.8.0.5]: https://github.com/spl/dlist/compare/v0.8.0.4...v0.8.0.5 +[v0.8.0.6]: https://github.com/spl/dlist/compare/v0.8.0.5...v0.8.0.6 +[v0.8.0.7]: https://github.com/spl/dlist/compare/v0.8.0.6...v0.8.0.7 +[v0.8.0.8]: https://github.com/spl/dlist/compare/v0.8.0.7...v0.8.0.8 +[v1.0]: https://github.com/spl/dlist/compare/v0.8.0.8...v1.0 + + + +[Unreleased]: https://github.com/spl/dlist/compare/v1.0...HEAD + + + +[#1]: https://github.com/spl/dlist/pull/1 +[#2]: https://github.com/spl/dlist/pull/2 +[#4]: https://github.com/spl/dlist/issues/4 +[#6]: https://github.com/spl/dlist/pull/6 +[#9]: https://github.com/spl/dlist/pull/9 +[#10]: https://github.com/spl/dlist/issues/10 +[#13]: https://github.com/spl/dlist/pull/13 +[#15]: https://github.com/spl/dlist/issues/15 +[#22]: https://github.com/spl/dlist/pull/22 +[#23]: https://github.com/spl/dlist/pull/23 +[#25]: https://github.com/spl/dlist/issues/25 +[#26]: https://github.com/spl/dlist/pull/26 +[#28]: https://github.com/spl/dlist/issues/28 +[#29]: https://github.com/spl/dlist/pull/29 +[#30]: https://github.com/spl/dlist/pull/30 +[#31]: https://github.com/spl/dlist/pull/31 +[#32]: https://github.com/spl/dlist/pull/32 +[#33]: https://github.com/spl/dlist/pull/33 +[#35]: https://github.com/spl/dlist/pull/35 +[#36]: https://github.com/spl/dlist/pull/36 +[#43]: https://github.com/spl/dlist/pull/43 +[#45]: https://github.com/spl/dlist/pull/45 +[#46]: https://github.com/spl/dlist/pull/46 +[#47]: https://github.com/spl/dlist/pull/47 +[#50]: https://github.com/spl/dlist/pull/50 +[#55]: https://github.com/spl/dlist/pull/55 +[#59]: https://github.com/spl/dlist/pull/59 +[#60]: https://github.com/spl/dlist/pull/60 +[#69]: https://github.com/spl/dlist/pull/69 +[#70]: https://github.com/spl/dlist/pull/70 +[#71]: https://github.com/spl/dlist/pull/71 +[#72]: https://github.com/spl/dlist/pull/72 +[#73]: https://github.com/spl/dlist/pull/73 +[#74]: https://github.com/spl/dlist/pull/74 +[#76]: https://github.com/spl/dlist/pull/76 +[#77]: https://github.com/spl/dlist/pull/77 + + + +[`0e2b3a5`]: https://github.com/spl/dlist/commit/0e2b3a542796b50796f2aa6dde4665911b9d15a1 +[`242511c`]: https://github.com/spl/dlist/commit/242511c501299b38c57efeafb9e604f29cb8bb7a +[`2d8ec37`]: https://github.com/spl/dlist/commit/2d8ec370a3c19d39c0d543f39f8fc31948087fd9 +[`3176153`]: https://github.com/spl/dlist/commit/3176153187b130002a1577675cdcd5509dd86556 +[`3d9c8ad`]: https://github.com/spl/dlist/commit/3d9c8ad348b419590a121b8a1604e8ebd01bffbe +[`4f92012`]: https://github.com/spl/dlist/commit/4f920128592f6f99b8c57a1adf50cdb16d26c13b +[`58ef305`]: https://github.com/spl/dlist/commit/58ef305146474d77a49a3f9e0148393eb6546fd2 +[`5b1d09f`]: https://github.com/spl/dlist/commit/5b1d09f6daad5543d927a003b4ea5ca50f3e6604 +[`5b41d0d`]: https://github.com/spl/dlist/commit/5b41d0d84a0a14c75798ca30883b613b37ad464a +[`62c0c09`]: https://github.com/spl/dlist/commit/62c0c099d20c3f950d7950dc9ec5a6b3797acaf8 +[`6e1d9e7`]: https://github.com/spl/dlist/commit/6e1d9e74e0a7c7f9c6612cd6bd0b4753f5651968 +[`7494dbc`]: https://github.com/spl/dlist/commit/7494dbc56550a0f7eb09304403a61c68b4a360e3 +[`771a38d`]: https://github.com/spl/dlist/commit/771a38df953b97a631806884133a76ab8dfcfce8 +[`77f6898`]: https://github.com/spl/dlist/commit/77f689829223b5fd6762e24594ce9111e6ef8f6b +[`9f58759`]: https://github.com/spl/dlist/commit/9f587599f128a4dc147c5c8f907b29b46110763b +[`a7ea60d`]: https://github.com/spl/dlist/commit/a7ea60d3d02775216a15d6f688db230d7735c9d1 +[`b2f791a`]: https://github.com/spl/dlist/commit/b2f791ab98e2091303fff4567727716b6021b63e +[`ef7eac5`]: https://github.com/spl/dlist/commit/ef7eac55fc7e180ac3441657f4971ed171b0669c + + + +[Adam Bergmark]: https://github.com/bergmark +[Baldur Blöndal]: https://github.com/Icelandjack +[Bas van Dijk]: https://github.com/basvandijk +[Bertram Felgenhauer]: https://github.com/int-e +[Don Stewart]: https://github.com/donsbot +[Evan Laforge]: https://github.com/elaforge +[Herbert Valerio Riedel]: https://github.com/hvr +[Jacob Leach]: https://github.com/riz0id +[Janek Spaderna]: https://github.com/JaSpa +[Michael Snoyman]: https://github.com/snoyberg +[Mikhail Glushenkov]: https://github.com/23Skidoo +[Oleg Grenrus]: https://github.com/phadej +[Ryan Scott]: https://github.com/RyanGlScott +[Sean Leather]: https://github.com/spl +[Sergei Trofimovich]: https://github.com/trofi +[Simon Jakobi]: https://github.com/sjakobi +[Vanessa McHale]: https://github.com/vmchale +[Veronika Romashkina]: https://github.com/vrom911 diff --git a/dlist.cabal b/dlist.cabal --- a/dlist.cabal +++ b/dlist.cabal @@ -1,31 +1,99 @@ -Name: dlist -Version: 0.5 -Synopsis: Differences lists -Description: - Differences lists: 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: dons@galois.com -Copyright: 2006-9 Don Stewart -Homepage: http://code.haskell.org/~dons/code/dlist/ -extra-source-files: README tests/Properties.hs tests/Parallel.hs -build-type: Simple -cabal-version: >= 1.2 +cabal-version: >= 1.10 -flag applicative-in-base +name: dlist +version: 1.0 +synopsis: Difference lists +description: + List-like types supporting O(1) append and snoc operations. +category: Data +license: BSD3 +license-file: license.md +author: Don Stewart +maintainer: Sean Leather +copyright: 2006-2009 Don Stewart, 2013-2020 Sean Leather, 2017-2020 Oleg Grenrus, contributors +homepage: https://github.com/spl/dlist +bug-reports: https://github.com/spl/dlist/issues +extra-source-files: readme.md, + changelog.md + tests/ImportUnsafe.hs +build-type: Simple +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.2 + GHC==8.2.2 + GHC==8.4.4 + GHC==8.6.5 + GHC==8.8.3 + GHC==8.10.1 -Library - Build-Depends: base - Ghc-options: -O2 -Wall - Extensions: CPP - Exposed-modules: Data.DList - if flag(applicative-in-base) - build-depends: base >= 2.0 && < 5 - cpp-options: -DAPPLICATIVE_IN_BASE - else - build-depends: base < 2.0 +source-repository head + type: git + location: git://github.com/spl/dlist.git + +flag Werror + description: Enable -Werror + default: False + manual: True + +library + build-depends: + base >= 4 && < 5, + deepseq >= 1.1 && < 1.5 + exposed-modules: Data.DList + Data.DList.Unsafe + other-modules: Data.DList.Internal + if impl(ghc >= 8.0) + exposed-modules: Data.DList.DNonEmpty + other-modules: Data.DList.DNonEmpty.Internal + default-language: Haskell2010 + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + if impl(ghc >= 8.2) + ghc-options: -Wmissing-home-modules + if impl(ghc >= 8.4) + ghc-options: -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wmissing-safe-haskell-mode + -Wtrustworthy-safe + if flag(Werror) + ghc-options: -Werror + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: DListProperties + OverloadedStrings + QuickCheckUtil + if impl(ghc >= 8.0) + other-modules: DNonEmptyProperties + hs-source-dirs: tests + build-depends: dlist, + base, + -- 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.15 + default-language: Haskell2010 + ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + if impl(ghc >= 8.2) + ghc-options: -Wmissing-home-modules + if impl(ghc >= 8.4) + ghc-options: -Wpartial-fields + if impl(ghc >= 8.10) + ghc-options: -Wmissing-safe-haskell-mode + -Wtrustworthy-safe + if flag(Werror) + ghc-options: -Werror diff --git a/license.md b/license.md new file mode 100644 --- /dev/null +++ b/license.md @@ -0,0 +1,28 @@ +Copyright © 2006-2009 Don Stewart, 2013-2020 Sean Leather, contributors + +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the copyright holders 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 HOLDERS 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. diff --git a/readme.md b/readme.md new file mode 100644 --- /dev/null +++ b/readme.md @@ -0,0 +1,269 @@ +# Difference Lists + +[![test-badge][]][test] +[![hackage-badge][]][hackage-dlist] +[![packdeps-badge][]][packdeps] + +_**List-like types supporting O(1) `append` and `snoc` operations.**_ + +## Installation + +[`dlist`][hackage-dlist] is a Haskell package available from [Hackage][hackage]. +It can be installed with [`cabal`][cabal] or [`stack`][stack]. + +See the [change log][changelog] for the changes in each version. + +## Usage + +Here is an example of “flattening” a `Tree` into a list of the elements in its +`Leaf` constructors: + +```haskell +import qualified Data.DList as DList + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +flattenSlow :: Tree a -> [a] +flattenSlow = go + where + go (Leaf x) = [x] + go (Branch left right) = go left ++ go right + +flattenFast :: Tree a -> [a] +flattenFast = DList.toList . go + where + go (Leaf x) = DList.singleton x + go (Branch left right) = go left `DList.append` go right +``` + +(The above code can be found in the [benchmark][].) + +`flattenSlow` is likely to be slower than `flattenFast`: + +1. `flattenSlow` uses `++` to concatenate lists, each of which is recursively + constructed from the `left` and `right` `Tree` values in the `Branch` + constructor. + +2. `flattenFast` does not use `++` but constructs a composition of functions, + each of which is a “cons” introduced by `DList.singleton` (`(x :)`). The + function `DList.toList` applies the composed function to `[]`, constructing + a list in the end. + +To see the difference between `flattenSlow` and `flattenFast`, consider some +rough evaluations of the functions applied to a `Tree`: + +```haskell +flattenSlow (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) + = go (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) + = go (Branch (Leaf 'a') (Leaf 'b')) ++ go (Leaf 'c') + = (go (Leaf 'a') ++ go (Leaf 'b')) ++ "c" + = ("a" ++ "b") ++ "c" + = ('a' : [] ++ "b") ++ "c" + = ('a' : "b") ++ "c" + = 'a' : "b" ++ "c" + = 'a' : 'b' : [] ++ "c" + = 'a' : 'b' : "c" +``` + +```haskell +flattenFast (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) + = toList $ go (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) + = toList $ go (Branch (Leaf 'a') (Leaf 'b')) `append` go (Leaf 'c') + = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) . unsafeApplyDList (go (Leaf 'c')) $ [] + = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (go (Leaf 'c')) []) + = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (singleton 'c') []) + = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (UnsafeDList ((:) 'c')) []) + = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) "c" + = unsafeApplyDList (UnsafeDList (unsafeApplyDList (go (Leaf 'a')) . unsafeApplyDList (go (Leaf 'b')))) "c" + = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (go (Leaf 'b')) "c") + = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (singleton 'b') "c") + = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (UnsafeDList ((:) 'b')) "c") + = unsafeApplyDList (go (Leaf 'a')) ('b' : "c") + = unsafeApplyDList (singleton 'a') ('b' : "c") + = unsafeApplyDList (UnsafeDList ((:) 'a')) ('b' : "c") + = 'a' : 'b' : "c" +``` + +The left-nested `++` in `flattenSlow` results in intermediate list constructions +that are immediately discarded in the evaluation of the outermost `++`. On the +other hand, the evaluation of `flattenFast` involves no intermediate list +construction but rather function applications and `newtype` constructor wrapping +and unwrapping. This is where the efficiency comes from. + +_**Warning!**_ Note that there is truth in the above, but there is also a lot of +hand-waving and intrinsic complexity. For example, there may be GHC rewrite +rules that apply to `++`, which will change the actual evaluation. And, of +course, strictness, laziness, and sharing all play a significant role. Also, not +every function in the `dlist` package is the most efficient for every situation. + +_**Moral of the story:**_ If you are using `dlist` to speed up your code, check +to be sure that it actually does. Benchmark! + +## Design Notes + +These are some notes on design and development choices made for the `dlist` +package. + +### Avoid `++` + +The original intent of Hughes' representation of lists as first-class functions +was to provide an abstraction such that the list `append` operation found in +functional programming languages (and now called `++` in Haskell) would not +appear in left-nested positions to avoid duplicated structure as lists are +constructed. The lesson learned by many people using list over the years is that +the `append` operation can appear, sometimes surprisingly, in places they don't +expect it. + +One of our goals is for the `dlist` package to avoid surprising its users with +unexpected insertions of `++`. Towards this end, there should be a minimal set +of functions in `dlist` in which `++` can be directly or indirectly found. The +list of known uses of `++` includes: + +* `DList`: `fromList`, `fromString`, `read` +* `DNonEmpty`: `fromList`, `fromNonEmpty`, `fromString`, `read` + +If any future requested functions involve `++` (e.g. via `fromList`), the burden +of inclusion is higher than it would be otherwise. + +### Abstraction + +The `DList` representation and its supporting functions (e.g. `append`, `snoc`, +etc.) rely on an invariant to preserve its safe use. That is, without this +invariant, a user may encounter unexpected outcomes. + +(We use safety in the sense that the semantics are well-defined and expected, +not in the sense of side of referential transparency. The invariant does not +directly lead to side effects in the `dlist` package, but a program that uses an +unsafely generated `DList` may do something surprising.) + +The invariant is that, for any `xs :: DList a`: + +```haskell +fromList (toList xs) = xs +``` + +To see how this invariant can be broken, consider this example: + +```haskell +xs :: DList a +xs = UnsafeDList (const []) + +fromList (toList (xs `snoc` 1)) + = fromList (toList (UnsafeDList (const []) `snoc` 1)) + = fromList (toList (UnsafeDList (unsafeApplyDList (UnsafeDList (const [])) . (x :)))) + = fromList (toList (UnsafeDList (const [] . (x :)))) + = fromList (($ []) . unsafeApplyDList $ UnsafeDList (const [] . (x :))) + = fromList (const [] . (x :) $ []) + = fromList (const [] [x]) + = fromList [] + = UnsafeDList (++ []) +``` + +The invariant can also be stated as: + +```haskell +toList (fromList (toList xs)) = toList xs +``` + +And we can restate the example as: + +```haskell +toList (fromList (toList (xs `snoc` 1))) + = toList (UnsafeDList (++ [])) + = [] +``` + +It would be rather unhelpful and surprising to find ``(xs `snoc` 1)`` turned out +to be the empty list. + +To preserve the invariant on `DList`, we provide it as an abstract type in the +`Data.DList` module. The constructor, `UnsafeDList`, and record label, +`unsafeApplyDList`, are not exported because these can be used, as shown above, +to break the invariant. + +All of that said, there have been numerous requests to export the `DList` +constructor. We are not convinced that it is necessary, but we are convinced +that users should decide for themselves. + +To use the constructor and record label of `DList`, you import them as follows: + +```haskell +import Data.DList.Unsafe (DList(UnsafeDList, unsafeApplyDList)) +``` + +If you are using Safe Haskell, you may need to add this at the top of your +module: + +```haskell +{-# LANGUAGE Trustworthy #-} +``` + +Just be aware that the burden of proof for safety is on you. + +## References + +These are various references where you can learn more about difference lists. + +### Research + +* **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][hughes-pdf] + + This is the original published source for a representation of lists as + first-class functions. + +### Background + +* [Wikipedia][wikipedia] +* [Haskell Wiki][wiki-haskell] +* [Stack Overflow][stack-overflow] + +### Blogs and Mailing Lists + +* [Using Difference Lists][blog-auclair-1]. Douglas M. Auclair. 2008-08-13. +* [A Sort of Difference][blog-kmett]. Edward Kmett. 2008-09-18. +* [Reference for technique wanted][mail-okeefe]. Richard O'Keefe, et al. + 2010-10-31. +* [24 Days of Hackage: dlist][blog-charles]. Oliver Charles. 2012-12-14. +* [Constructing a list in a Monad][blog-breitner]. Joachim Breitner. 2013-11-13. +* [Demystifying DList][blog-ellis] ([Reddit][blog-ellis-reddit]). Tom Ellis. + 2014-01-24. +* [keepEquals with Difference Lists][blog-auclair-2]. Douglas M. Auclair. + 2014-06-21. + +### Books + +* [Chapter 13. Data Structures][book-real-world-haskell]. Real World Haskell. + 2008-12-05. + +## License + +[BSD 3-Clause “New” or “Revised” License][license] © Don Stewart, Sean Leather, +contributors + +[changelog]: https://github.com/spl/dlist/blob/main/changelog.md#change-log +[benchmark]: https://github.com/spl/dlist/blob/main/bench/Main.hs +[blog-auclair-1]: https://logicaltypes.blogspot.com/2008/08/using-difference-lists.html +[blog-auclair-2]: https://logicaltypes.blogspot.com/2014/06/keepequals-with-difference-lists.html +[blog-breitner]: https://www.joachim-breitner.de/blog/620-Constructing_a_list_in_a_Monad +[blog-charles]: https://ocharles.org.uk/blog/posts/2012-12-14-24-days-of-hackage-dlist.html +[blog-ellis-reddit]: https://www.reddit.com/r/haskell/comments/1w5duf/demystifying_dlist/ +[blog-ellis]: http://h2.jaguarpaw.co.uk/posts/demystifying-dlist/ +[blog-kmett]: https://web.archive.org/web/20080918101635/comonad.com/reader/2008/a-sort-of-difference/ +[book-real-world-haskell]: http://book.realworldhaskell.org/read/data-structures.html +[cabal]: https://cabal.readthedocs.io/ +[hackage-badge]: https://img.shields.io/hackage/v/dlist.svg?maxAge=3600 +[hackage-dlist]: https://hackage.haskell.org/package/dlist +[hackage]: https://hackage.haskell.org/ +[hughes-pdf]: https://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/lists.pdf +[license]: https://github.com/spl/dlist/blob/main/license.md +[mail-okeefe]: https://www.mail-archive.com/haskell-cafe@haskell.org/msg83699.html +[packdeps-badge]: https://img.shields.io/hackage-deps/v/dlist.svg?maxAge=3600 +[packdeps]: http://packdeps.haskellers.com/feed?needle=dlist +[stack-overflow]: https://stackoverflow.com/questions/3352418/what-is-a-dlist +[stack]: https://docs.haskellstack.org/ +[test-badge]: https://github.com/spl/dlist/workflows/test/badge.svg +[test]: https://github.com/spl/dlist/actions?query=workflow%3Atest +[wiki-haskell]: https://wiki.haskell.org/Difference_list +[wikipedia]: https://en.wikipedia.org/wiki/Difference_list diff --git a/tests/DListProperties.hs b/tests/DListProperties.hs new file mode 100644 --- /dev/null +++ b/tests/DListProperties.hs @@ -0,0 +1,188 @@ +{- ORMOLU_DISABLE -} +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for overloaded lists, Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +-- For the IsList test +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE Safe #-} +#endif + +-- CPP: GHC == 7.8 for using pattern synonyms +#if __GLASGOW_HASKELL__ == 708 +{-# LANGUAGE PatternSynonyms #-} +#endif +{- ORMOLU_ENABLE -} + +#if __GLASGOW_HASKELL__ >= 708 +#endif + +-------------------------------------------------------------------------------- + +-- | QuickCheck property tests for DList. +module DListProperties (test) where + +-------------------------------------------------------------------------------- + +import qualified Control.Applicative as Applicative +import Data.DList +import qualified Data.List as List +-- CPP: GHC >= 8 for NonEmpty, Semigroup +#if __GLASGOW_HASKELL__ >= 800 +import Data.List.NonEmpty (NonEmpty) +import qualified Data.Semigroup as Semigroup +#endif +import qualified Data.Traversable as Traversable +import QuickCheckUtil +import Test.QuickCheck +import Text.Show.Functions () +import Prelude hiding (concat, foldr, head, map, replicate, tail) + +-------------------------------------------------------------------------------- + +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 Applicative.pure (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 (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_intercalate :: [Int] -> [[Int]] -> Bool +prop_intercalate sep = + eqWith (List.intercalate sep) (toList . intercalate (fromList sep) . List.map 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 + +prop_fail :: String -> Bool +prop_fail str = fail str == (empty :: DList ()) + +prop_Traversable_traverse :: [Int] -> Bool +prop_Traversable_traverse xs = + (==) + (Traversable.traverse Applicative.pure xs :: [[Int]]) + (fmap toList (Traversable.traverse Applicative.pure (fromList xs))) + +-- CPP: GHC >= 7.8 for overloaded lists +#if __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 + +-- | Test the pattern synonyms +prop_patterns :: [Int] -> Bool +prop_patterns xs = case fromList xs of + Nil -> xs == [] + Cons y ys -> xs == (y : ys) + _ -> False + +#endif + +-- CPP: GHC >= 8 for NonEmpty, Semigroup +#if __GLASGOW_HASKELL__ >= 800 + +prop_Semigroup_append :: [Int] -> [Int] -> Bool +prop_Semigroup_append xs ys = + xs Semigroup.<> ys == toList (fromList xs Semigroup.<> fromList ys) + +prop_Semigroup_sconcat :: NonEmpty [Int] -> Bool +prop_Semigroup_sconcat xs = + Semigroup.sconcat xs == toList (Semigroup.sconcat (fmap fromList xs)) + +prop_Semigroup_stimes :: Int -> [Int] -> Bool +prop_Semigroup_stimes n xs = + n < 0 || Semigroup.stimes n xs == toList (Semigroup.stimes n (fromList xs)) + +#endif + +-------------------------------------------------------------------------------- + +properties :: [(String, Property)] +properties = + [ ("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), + ("fail", property prop_fail), + ("unfoldr", property prop_unfoldr), + ("foldr", property prop_foldr), + ("map", property prop_map), + ("map fusion", property (prop_map_fusion (+ 1) (+ 1))), + ("intercalate", property prop_intercalate), + ("read . show", property prop_show_read), + ("show . read", property prop_read_show), + ("Traversable traverse", property prop_Traversable_traverse) +-- CPP: GHC >= 7.8 for IsList, pattern synonyms +#if __GLASGOW_HASKELL__ >= 708 + , + ("IsList", property prop_IsList), + ("patterns", property prop_patterns) +#endif +-- CPP: GHC >= 8 for NonEmpty, Semigroup +#if __GLASGOW_HASKELL__ >= 800 + , + ("Semigroup <>", property prop_Semigroup_append), + ("Semigroup sconcat", property prop_Semigroup_sconcat), + ("Semigroup stimes", property prop_Semigroup_stimes) +#endif + ] + +test :: IO () +test = quickCheckLabeledProperties properties diff --git a/tests/DNonEmptyProperties.hs b/tests/DNonEmptyProperties.hs new file mode 100644 --- /dev/null +++ b/tests/DNonEmptyProperties.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif + +-------------------------------------------------------------------------------- + +-- | QuickCheck property tests for DNonEmpty. +module DNonEmptyProperties (test) where + +-------------------------------------------------------------------------------- + +import qualified Control.Applicative as Applicative +import qualified Data.DList as DList +import Data.DList.DNonEmpty +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Semigroup as Semigroup +import QuickCheckUtil +import Test.QuickCheck +import Text.Show.Functions () +import Prelude hiding (head, map, tail) + +-------------------------------------------------------------------------------- + +prop_model :: NonEmpty Int -> Bool +prop_model = eqWith id (toNonEmpty . fromNonEmpty) + +prop_singleton :: Int -> Bool +prop_singleton = eqWith Applicative.pure (toNonEmpty . singleton) + +prop_cons :: Int -> NonEmpty Int -> Bool +prop_cons c = eqWith (NonEmpty.cons c) (toNonEmpty . cons c . fromNonEmpty) + +prop_snoc :: NonEmpty Int -> Int -> Bool +prop_snoc xs c = + xs Semigroup.<> Applicative.pure c == toNonEmpty (snoc (fromNonEmpty xs) c) + +prop_append :: NonEmpty Int -> NonEmpty Int -> Bool +prop_append xs ys = + xs Semigroup.<> ys == toNonEmpty (fromNonEmpty xs `append` fromNonEmpty ys) + +prop_head :: NonEmpty Int -> Bool +prop_head = eqWith NonEmpty.head (head . fromNonEmpty) + +prop_tail :: NonEmpty Int -> Bool +prop_tail = eqWith NonEmpty.tail (DList.toList . tail . fromNonEmpty) + +prop_unfoldr :: (Int -> (Int, Maybe Int)) -> Int -> Int -> Property +prop_unfoldr f n = + eqOn + (const (n >= 0)) + (NonEmpty.take n . NonEmpty.unfoldr f) + (NonEmpty.take n . toNonEmpty . unfoldr f) + +prop_map :: (Int -> Int) -> NonEmpty Int -> Bool +prop_map f = eqWith (NonEmpty.map f) (toNonEmpty . map f . fromNonEmpty) + +prop_show_read :: NonEmpty Int -> Bool +prop_show_read = eqWith id (read . show) + +prop_read_show :: NonEmpty Int -> Bool +prop_read_show x = eqWith id (show . f . read) $ "fromNonEmpty " ++ show x + where + f :: NonEmpty Int -> NonEmpty Int + f = id + +exampleList :: [Int] +exampleList = [1, 2, 3] + +exampleDNonEmpty :: DNonEmpty Int +exampleDNonEmpty = 1 :| DList.fromList [2, 3] + +prop_toList :: Bool +prop_toList = toList exampleDNonEmpty == exampleList + +prop_fromList :: Bool +prop_fromList = exampleDNonEmpty == fromList exampleList + +prop_Semigroup_append :: NonEmpty Int -> NonEmpty Int -> Bool +prop_Semigroup_append xs ys = + (==) + (xs Semigroup.<> ys) + (toNonEmpty (fromNonEmpty xs Semigroup.<> fromNonEmpty ys)) + +-------------------------------------------------------------------------------- + +properties :: [(String, Property)] +properties = + [ ("model", property prop_model), + ("singleton", property prop_singleton), + ("cons", property prop_cons), + ("snoc", property prop_snoc), + ("append", property prop_append), + ("head", property prop_head), + ("tail", property prop_tail), + ("unfoldr", property prop_unfoldr), + ("map", property prop_map), + ("read . show", property prop_show_read), + ("show . read", property prop_read_show), + ("toList", property prop_toList), + ("fromList", property prop_fromList), + ("Semigroup <>", property prop_Semigroup_append) + ] + +test :: IO () +test = quickCheckLabeledProperties properties diff --git a/tests/ImportUnsafe.hs b/tests/ImportUnsafe.hs new file mode 100644 --- /dev/null +++ b/tests/ImportUnsafe.hs @@ -0,0 +1,38 @@ +{- ORMOLU_DISABLE -} +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#else +#error "Your GHC does not support Safe Haskell. That's okay!" +#endif + +----------------------------------------------------------------------------- + +{-| + +This module is declared @Safe@ but imports a module declared @Unsafe@. +Therefore, any attempt to compile this module should fail. + +We use @#error@ above just to make it fail for older versions of GHC that did +not support Safe Haskell. + +Run this test in the top-level directory with the following command: + +> ! ghc tests/ImportUnsafe.hs + +-} +{- ORMOLU_ENABLE -} + +module ImportUnsafe (main) where + +----------------------------------------------------------------------------- + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +import Data.DList.Unsafe () +#endif + +main :: IO () +main = putStrLn "You should not see this message because this module should fail to compile." diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif + +-------------------------------------------------------------------------------- + +-- | Test runner. +module Main (main) where + +-------------------------------------------------------------------------------- + +import qualified DListProperties +-- CPP: GHC >= 8 for DNonEmpty +#if __GLASGOW_HASKELL__ >= 800 +import qualified DNonEmptyProperties +#endif +import qualified OverloadedStrings + +-------------------------------------------------------------------------------- + +main :: IO () +main = do + DListProperties.test +-- CPP: GHC >= 8 for DNonEmpty +#if __GLASGOW_HASKELL__ >= 800 + DNonEmptyProperties.test +#endif + OverloadedStrings.test diff --git a/tests/OverloadedStrings.hs b/tests/OverloadedStrings.hs new file mode 100644 --- /dev/null +++ b/tests/OverloadedStrings.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif + +{-# LANGUAGE OverloadedStrings #-} + +-------------------------------------------------------------------------------- + +-- | Tests using the OverloadedStrings language extension. +module OverloadedStrings (test) where + +-------------------------------------------------------------------------------- + +import qualified Data.DList as DList +-- CPP: GHC >= 8 for DNonEmpty +#if __GLASGOW_HASKELL__ >= 800 +import qualified Data.DList.DNonEmpty as DNonEmpty +#endif + +-------------------------------------------------------------------------------- + +test :: IO () +test = do + print $ "OverloadedStrings for DList: " `DList.append` "success" +-- CPP: GHC >= 8 for DNonEmpty +#if __GLASGOW_HASKELL__ >= 800 + print $ "OverloadedStrings for DNonEmpty: " `DNonEmpty.append` "success" +#endif diff --git a/tests/Parallel.hs b/tests/Parallel.hs deleted file mode 100644 --- a/tests/Parallel.hs +++ /dev/null @@ -1,148 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Test.QuickCheck.Parallel --- Copyright : (c) Don Stewart 2006 --- License : BSD-style (see the file LICENSE) --- --- Maintainer : dons@cse.unsw.edu.au --- Stability : experimental --- Portability : non-portable (uses Control.Exception, Control.Concurrent) --- --- A parallel batch driver for running QuickCheck on threaded or SMP systems. --- See the /Example.hs/ file for a complete overview. --- - -module Parallel ( - module Test.QuickCheck, - pRun, - pDet, - pNon - ) where - -import Test.QuickCheck -import Data.List -import Control.Concurrent -import Control.Exception hiding (evaluate) -import System.Random -import System.IO (hFlush,stdout) -import Text.Printf - -type Name = String -type Depth = Int -type Test = (Name, Depth -> IO String) - --- | Run a list of QuickCheck properties in parallel chunks, using --- 'n' Haskell threads (first argument), and test to a depth of 'd' --- (second argument). Compile your application with '-threaded' and run --- with the SMP runtime's '-N4' (or however many OS threads you want to --- donate), for best results. --- --- > import Test.QuickCheck.Parallel --- > --- > do n <- getArgs >>= readIO . head --- > pRun n 1000 [ ("sort1", pDet prop_sort1) ] --- --- Will run 'n' threads over the property list, to depth 1000. --- -pRun :: Int -> Int -> [Test] -> IO () -pRun n depth tests = do - chan <- newChan - ps <- getChanContents chan - work <- newMVar tests - - forM_ [1..n] $ forkIO . thread work chan - - let wait xs i - | i >= n = return () -- done - | otherwise = case xs of - Nothing : xs -> wait xs $! i+1 - Just s : xs -> putStr s >> hFlush stdout >> wait xs i - wait ps 0 - - where - thread :: MVar [Test] -> Chan (Maybe String) -> Int -> IO () - thread work chan me = loop - where - loop = do - job <- modifyMVar work $ \jobs -> return $ case jobs of - [] -> ([], Nothing) - (j:js) -> (js, Just j) - case job of - Nothing -> writeChan chan Nothing -- done - Just (name,prop) -> do - v <- prop depth - writeChan chan . Just $ printf "%d: %-25s: %s" me name v - loop - - --- | Wrap a property, and run it on a deterministic set of data -pDet :: Testable a => a -> Int -> IO String -pDet a n = mycheck Det defaultConfig - { configMaxTest = n - , configEvery = \n args -> unlines args } a - --- | Wrap a property, and run it on a non-deterministic set of data -pNon :: Testable a => a -> Int -> IO String -pNon a n = mycheck NonDet defaultConfig - { configMaxTest = n - , configEvery = \n args -> unlines args } a - -data Mode = Det | NonDet - ------------------------------------------------------------------------- - -mycheck :: Testable a => Mode -> Config -> a -> IO String -mycheck Det config a = do - let rnd = mkStdGen 99 -- deterministic - mytests config (evaluate a) rnd 0 0 [] - -mycheck NonDet config a = do - rnd <- newStdGen -- different each run - mytests config (evaluate a) rnd 0 0 [] - -mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO String -mytests config gen rnd0 ntest nfail stamps - | ntest == configMaxTest config = do done "OK," ntest stamps - | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps - | otherwise = do - case ok result of - Nothing -> - mytests config gen rnd1 ntest (nfail+1) stamps - Just True -> - mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps) - Just False -> - return ( "Falsifiable after " - ++ show ntest - ++ " tests:\n" - ++ unlines (arguments result) - ) - where - result = generate (configSize config ntest) rnd2 gen - (rnd1,rnd2) = split rnd0 - -done :: String -> Int -> [[String]] -> IO String -done mesg ntest stamps = - return ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) - where - table = display - . map entry - . reverse - . sort - . map pairLength - . group - . sort - . filter (not . null) - $ stamps - - display [] = ".\n" - display [x] = " (" ++ x ++ ").\n" - display xs = ".\n" ++ unlines (map (++ ".") xs) - - pairLength xss@(xs:_) = (length xss, xs) - entry (n, xs) = percentage n ntest - ++ " " - ++ concat (intersperse ", " xs) - - percentage n m = show ((100 * n) `div` m) ++ "%" - -forM_ = flip mapM_ diff --git a/tests/Properties.hs b/tests/Properties.hs deleted file mode 100644 --- a/tests/Properties.hs +++ /dev/null @@ -1,83 +0,0 @@ - -import qualified Prelude as P -import qualified Data.List as P (unfoldr) -import Prelude hiding (concat,map,head,tail,foldr,map,replicate) -import Data.List hiding (concat,map,head,tail,unfoldr,foldr,map,replicate) -import Text.Show.Functions - -import Parallel -import Data.DList - -type T = [Int] - -prop_model x = (toList . fromList $ (x :: T)) == id x - -prop_empty = ([] :: T) == (toList empty :: T) - -prop_singleton c = ([c] :: T) == toList (singleton c) - -prop_cons c xs = (c : xs :: T) == toList (cons c (fromList xs)) - -prop_snoc xs c = (xs ++ [c] :: T) == toList (snoc (fromList xs) c) - -prop_append xs ys = (xs ++ ys :: T) == toList (append (fromList xs) (fromList ys)) - -prop_concat zss = (P.concat zss) == toList (concat (P.map fromList zss)) - where _ = zss :: [T] - -prop_replicate n x = (P.replicate n x :: T) == toList (replicate n x) - -prop_head xs = not (null xs) ==> (P.head xs) == head (fromList xs) - where _ = xs :: T - -prop_tail xs = not (null xs) ==> (P.tail xs) == (toList . tail . fromList) xs - where _ = xs :: T - -prop_unfoldr f x n = n >= 0 ==> take n (P.unfoldr f x) - == take n (toList $ unfoldr f x) - where _ = x :: Int - _ = f :: Int -> Maybe (Int,Int) - -prop_foldr f x xs = (P.foldr f x xs) == (foldr f x (fromList xs)) - where _ = x :: Int - _ = f :: Int -> Int -> Int - -prop_map f xs = (P.map f xs) == (toList $ map f (fromList xs)) - where _ = f :: Int -> Int - -prop_map_fusion f g xs = (P.map f . P.map g $ xs) - == (toList $ map f . map g $ fromList xs) - where _ = f :: Int -> Int - --- --- run 8 threads simultaneously --- -main = pRun 8 300 - [ ("model", pDet prop_model) - , ("empty", pDet prop_empty) - , ("singleton", pDet prop_singleton) - , ("cons", pDet prop_cons) - , ("snoc", pDet prop_snoc) - , ("append", pDet prop_append) - , ("concat", pDet prop_concat) - , ("replicate", pDet prop_replicate) - , ("head", pDet prop_head) - , ("tail", pDet prop_tail) - , ("unfoldr", pDet prop_unfoldr) - , ("foldr", pDet prop_foldr) - , ("map", pDet prop_map) - , ("map fusion",pDet prop_map) - ] - - ------------------------------------------------------------------------- --- --- missing QC instances --- - -{- -instance Arbitrary a => Arbitrary (Maybe a) where - arbitrary = do a <- arbitrary ; elements [Nothing, Just a] - coarbitrary Nothing = variant 0 - coarbitrary _ = variant 1 -- ok? - -} diff --git a/tests/QuickCheckUtil.hs b/tests/QuickCheckUtil.hs new file mode 100644 --- /dev/null +++ b/tests/QuickCheckUtil.hs @@ -0,0 +1,68 @@ +{- ORMOLU_DISABLE -} +-- Options passed to GHC +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-------------------------------------------------------------------------------- + +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif +{- ORMOLU_ENABLE -} + +-------------------------------------------------------------------------------- + +-- | QuickCheck utilities for testing. +module QuickCheckUtil where + +-------------------------------------------------------------------------------- + +-- CPP: GHC >= 8 for NonEmpty +#if __GLASGOW_HASKELL__ >= 800 +import Control.Applicative (liftA2) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.Maybe (mapMaybe) +#endif +import Test.QuickCheck + +-------------------------------------------------------------------------------- + +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 + +-------------------------------------------------------------------------------- + +quickCheckLabeledProperties :: [(String, Property)] -> IO () +quickCheckLabeledProperties = quickCheck . conjoin . map (uncurry label) + +-------------------------------------------------------------------------------- + +-- CPP: GHC >= 8 for NonEmpty +#if __GLASGOW_HASKELL__ >= 800 + +{- + +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 + {-# INLINABLE arbitrary #-} + arbitrary = arbitrary1 + {-# INLINABLE shrink #-} + shrink = shrink1 + +#endif