diff --git a/ChangeLog.md b/ChangeLog.md deleted file mode 100644 --- a/ChangeLog.md +++ /dev/null @@ -1,166 +0,0 @@ - -Change Log -========== - -Version 0.8.0.8 (2020-04-02) *World Autism Awareness Day* ---------------------------------------------------------- - -#### Package changes - -* Change QuickCheck upper bound from 2.14 to 2.15 - -Version 0.8.0.7 (2019-08-05) *Independence Day in Burkina Faso* ---------------------------------------------------------------- - -#### Package changes - -* Add `MonadFail` instance for GHC >= 8.8 - ([Vanessa McHale](https://github.com/vmchale)) -* Change `deepseq` upper bound to 1.5 - ([Herbert Valerio Riedel](https://github.com/hvr)) - -Version 0.8.0.6 (2019-03-29) *Martyrs' Day in Madagascar* ---------------------------------------------------------- - -#### Package changes - -* Change QuickCheck upper bound from 2.13 to 2.14 - -Version 0.8.0.5 (2018-09-13) *Day of the Programmer* ----------------------------------------------------- - -#### Package changes - -* Change QuickCheck upper bound from 2.12 to 2.13 - -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 diff --git a/Data/DList.hs b/Data/DList.hs --- a/Data/DList.hs +++ b/Data/DList.hs @@ -1,365 +1,94 @@ -{-# OPTIONS_GHC -O2 #-} -{-# OPTIONS_HADDOCK prune #-} +{- ORMOLU_DISABLE -} {-# LANGUAGE CPP #-} -{-# LANGUAGE TypeFamilies #-} -- For the IsList and IsString instances -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 +-- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list +#if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 {-# 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-2019 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(..)) -#if !MIN_VERSION_base(4,13,0) -import Control.Monad.Fail (MonadFail(..)) -#endif -#endif - -#ifdef __GLASGOW_HASKELL__ - -import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, - readListPrecDefault) - +-- CPP: GHC >= 7.8 for Safe Haskell #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 -> []) +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. --- | 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) +-} +{-# LANGUAGE Trustworthy #-} #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(1)/. 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 #-} +Module: Data.DList +Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather +License: BSD-3-Clause --- | /O(n)/. Map over difference lists. -map :: (a -> b) -> DList a -> DList b -map f = foldr (cons . f) empty -{-# INLINE map #-} +Maintainer: sean.leather@gmail.com +Stability: stable -instance Eq a => Eq (DList a) where - (==) = (==) `on` toList +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. -instance Ord a => Ord (DList a) where - compare = compare `on` toList +-} +{- ORMOLU_ENABLE -} --- The Read and Show instances were adapted from Data.Sequence. +module Data.DList + ( -- * Difference List Type -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 +-- CPP: GHC >= 8 for pattern synonyms allowed in the constructor +#if __GLASGOW_HASKELL__ >= 800 + DList (Nil, Cons), #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 #-} + DList, -#if !MIN_VERSION_base(4,13,0) - fail _ = empty - {-# INLINE fail #-} +-- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list +#if __GLASGOW_HASKELL__ >= 708 + -- ** Bundled Patterns + pattern Nil, + pattern Cons, #endif -#if MIN_VERSION_base(4,9,0) -instance MonadFail DList where - fail _ = empty - {-# INLINE fail #-} #endif -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' #-} + -- * Conversion + fromList, + toList, + apply, - foldr' f x = F.foldr' f x . toList - {-# INLINE foldr' #-} -#endif + -- * Basic Functions + empty, + singleton, + cons, + snoc, + append, + concat, + replicate, + head, + tail, + unfoldr, + foldr, + map, + intercalate, + ) +where --- CPP: toList added to Foldable in base-4.8.0.0 -#if MIN_VERSION_base(4,8,0) - toList = Data.DList.toList - {-# INLINE toList #-} -#endif +----------------------------------------------------------------------------- -instance NFData a => NFData (DList a) where - rnf = rnf . toList - {-# INLINE rnf #-} +import Data.DList.Internal --- 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 #-} +{- ORMOLU_DISABLE -} +{- -#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 +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'. -#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 +-} +{- 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 (c) 2006-2009 Don Stewart, 2013-2019 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. diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,60 +0,0 @@ -# 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](https://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 list](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](https://logicaltypes.blogspot.com/2008/08/using-difference-lists.html). - Douglas M. Auclair. 2008-08-13. - -2. [A Sort of Difference](https://web.archive.org/web/20080918101635/comonad.com/reader/2008/a-sort-of-difference/). - Edward Kmett. 2008-09-18. - -3. [Reference for technique wanted](https://www.mail-archive.com/haskell-cafe@haskell.org/msg83699.html). - 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](https://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. 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,22 +1,22 @@ +cabal-version: >= 1.10 + name: dlist -version: 0.8.0.8 +version: 1.0 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. + List-like types supporting O(1) append and snoc operations. category: Data license: BSD3 -license-file: LICENSE +license-file: license.md author: Don Stewart maintainer: Sean Leather -copyright: 2006-2009 Don Stewart, 2013-2019 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 +extra-source-files: readme.md, + changelog.md + tests/ImportUnsafe.hs build-type: Simple -cabal-version: >= 1.9.2 tested-with: GHC==7.0.4 GHC==7.2.2 GHC==7.4.2 @@ -27,29 +27,73 @@ GHC==8.2.2 GHC==8.4.4 GHC==8.6.5 - GHC==8.8.1 + GHC==8.8.3 + GHC==8.10.1 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 - extensions: CPP 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: OverloadedStrings + other-modules: DListProperties + OverloadedStrings + QuickCheckUtil + if impl(ghc >= 8.0) + other-modules: DNonEmptyProperties 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.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 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,185 +1,31 @@ -{-# 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(..)) +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} #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 - -prop_fail :: String -> Bool -prop_fail str = fail str == (empty :: DList ()) - -#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 +-- | Test runner. +module Main (main) where -------------------------------------------------------------------------------- -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) - , ("fail", property prop_fail) - , ("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) +import qualified DListProperties +-- CPP: GHC >= 8 for DNonEmpty +#if __GLASGOW_HASKELL__ >= 800 +import qualified DNonEmptyProperties #endif - ] +import qualified OverloadedStrings -------------------------------------------------------------------------------- main :: IO () main = do - testOverloadedStrings - quickCheck $ conjoin $ List.map (uncurry label) props + 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 --- a/tests/OverloadedStrings.hs +++ b/tests/OverloadedStrings.hs @@ -1,8 +1,31 @@ +{-# LANGUAGE CPP #-} + +-- CPP: GHC >= 7.8 for Safe Haskell +#if __GLASGOW_HASKELL__ >= 708 +{-# LANGUAGE Safe #-} +#endif + {-# LANGUAGE OverloadedStrings #-} -module OverloadedStrings (testOverloadedStrings) where +-------------------------------------------------------------------------------- -import Data.DList +-- | Tests using the OverloadedStrings language extension. +module OverloadedStrings (test) where -testOverloadedStrings :: IO () -testOverloadedStrings = print $ "OverloadedStrings:" `append` " success" +-------------------------------------------------------------------------------- + +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/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