├── Data ├── DList.hs └── DList │ ├── DNonEmpty.hs │ ├── DNonEmpty │ └── Internal.hs │ ├── Internal.hs │ └── Unsafe.hs ├── Setup.lhs ├── bench ├── Main.hs ├── Setup.hs ├── dlist-bench.cabal └── readme.md ├── changelog.md ├── dlist.cabal ├── doc └── release.md ├── license.md ├── readme.md └── tests ├── DListProperties.hs ├── DNonEmptyProperties.hs ├── ImportUnsafe.hs ├── Main.hs ├── OverloadedStrings.hs └── QuickCheckUtil.hs /Data/DList.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | {-# LANGUAGE CPP #-} 3 | 4 | -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list 5 | #if __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800 6 | {-# LANGUAGE PatternSynonyms #-} 7 | #endif 8 | 9 | -- CPP: GHC >= 7.8 for Safe Haskell 10 | #if __GLASGOW_HASKELL__ >= 708 11 | {- 12 | 13 | The 'Data.DList' module imports the unsafe module 'Data.DList.Internal' but 14 | exports only its safe aspects. Specifically, it does not export the 'DList' 15 | constructor 'UnsafeDList' or record label 'unsafeApplyDList'. Therefore, we mark 16 | 'Data.DList' as trustworthy. 17 | 18 | -} 19 | {-# LANGUAGE Trustworthy #-} 20 | #endif 21 | 22 | ----------------------------------------------------------------------------- 23 | 24 | {-| 25 | 26 | Module: Data.DList 27 | Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather 28 | License: BSD-3-Clause 29 | 30 | Maintainer: sean.leather@gmail.com 31 | Stability: stable 32 | 33 | A __difference list__ is an abstraction representing a list that 34 | supports \(\mathcal{O}\)(@1@) 'append' and 'snoc' operations. This module 35 | provides the type for a difference list, 'DList', and a collection of supporting 36 | functions for (a) converting to and from lists and (b) operating on 'DList's 37 | efficiently. 38 | 39 | -} 40 | {- ORMOLU_ENABLE -} 41 | 42 | module Data.DList 43 | ( -- * Difference List Type 44 | 45 | -- CPP: GHC >= 8 for pattern synonyms allowed in the constructor 46 | #if __GLASGOW_HASKELL__ >= 800 47 | DList (Nil, Cons), 48 | #else 49 | DList, 50 | 51 | -- CPP: GHC >= 7.8 && <= 8 for 'pattern' required in the export list 52 | #if __GLASGOW_HASKELL__ >= 708 53 | -- ** Bundled Patterns 54 | pattern Nil, 55 | pattern Cons, 56 | #endif 57 | 58 | #endif 59 | 60 | -- * Conversion 61 | fromList, 62 | toList, 63 | apply, 64 | 65 | -- * Basic Functions 66 | empty, 67 | singleton, 68 | cons, 69 | snoc, 70 | append, 71 | concat, 72 | replicate, 73 | head, 74 | tail, 75 | unfoldr, 76 | foldr, 77 | map, 78 | intercalate, 79 | ) 80 | where 81 | 82 | ----------------------------------------------------------------------------- 83 | 84 | import Data.DList.Internal 85 | 86 | {- ORMOLU_DISABLE -} 87 | {- 88 | 89 | The 'Data.DList' module exists only to export names from 'Data.DList.Internal'. 90 | Some names conflict with 'Prelude', so we hide all imports from 'Prelude'. 91 | 92 | -} 93 | {- ORMOLU_ENABLE -} 94 | import Prelude () 95 | -------------------------------------------------------------------------------- /Data/DList/DNonEmpty.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | {-# LANGUAGE CPP #-} 3 | 4 | -- CPP: GHC >= 7.8 for Safe Haskell 5 | #if __GLASGOW_HASKELL__ >= 708 6 | {-# LANGUAGE Safe #-} 7 | #endif 8 | 9 | ----------------------------------------------------------------------------- 10 | 11 | -- CPP: Ignore unused imports when Haddock is run 12 | #if defined(__HADDOCK_VERSION__) 13 | {-# OPTIONS_GHC -Wno-unused-imports #-} 14 | #endif 15 | 16 | ----------------------------------------------------------------------------- 17 | 18 | {-| 19 | 20 | Module: Data.DList.DNonEmpty 21 | Copyright: © 2017-2020 Oleg Grenrus, 2020 Sean Leather 22 | License: BSD-3-Clause 23 | 24 | Maintainer: sean.leather@gmail.com 25 | Stability: stable 26 | 27 | A __non-empty difference list__ is a difference list paired with a 'head' 28 | element. Like the difference list, it supports \(\mathcal{O}\)(@1@) 29 | 'append' and 'snoc' operations. 30 | 31 | This module provides the type for a non-empty difference list, 'DNonEmpty', and 32 | a collection of supporting functions for (a) converting to and from 'NonEmpty' 33 | and 'DList' and (b) operating efficiently on 'DNonEmpty' values. The functions 34 | also retain the non-strict semantics of 'NonEmpty'. 35 | 36 | -} 37 | {- ORMOLU_ENABLE -} 38 | 39 | module Data.DList.DNonEmpty 40 | ( -- * Non-Empty Difference List Type 41 | DNonEmpty((:|)), 42 | 43 | -- * Conversion 44 | fromNonEmpty, 45 | toNonEmpty, 46 | toList, 47 | fromList, 48 | 49 | -- * Basic Functions 50 | singleton, 51 | cons, 52 | snoc, 53 | append, 54 | head, 55 | tail, 56 | unfoldr, 57 | map, 58 | ) 59 | where 60 | 61 | ----------------------------------------------------------------------------- 62 | 63 | import Data.DList.DNonEmpty.Internal 64 | 65 | -- CPP: Import only for Haddock 66 | #if defined(__HADDOCK_VERSION__) 67 | import Data.List.NonEmpty (NonEmpty) 68 | import Data.DList (DList) 69 | #endif 70 | 71 | {- ORMOLU_DISABLE -} 72 | {- 73 | 74 | The 'Data.DList.DNonEmpty' module exists only to export names from 75 | 'Data.DList.DNonEmpty.Internal'. Some names conflict with 'Prelude', so we hide 76 | all imports from 'Prelude'. 77 | 78 | -} 79 | {- ORMOLU_ENABLE -} 80 | import Prelude () 81 | -------------------------------------------------------------------------------- /Data/DList/DNonEmpty/Internal.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | -- Options passed to GHC 3 | {-# OPTIONS_GHC -O2 #-} 4 | -- Options passed to Haddock 5 | {-# OPTIONS_HADDOCK hide #-} 6 | 7 | ----------------------------------------------------------------------------- 8 | 9 | {-# LANGUAGE CPP #-} 10 | 11 | -- CPP: GHC >= 7.8 for Safe Haskell 12 | #if __GLASGOW_HASKELL__ >= 708 13 | {- 14 | 15 | This module imports the unsafe module 'GHC.Exts' for 'IsList' but does not use 16 | any unsafe features. Therefore, we mark the module as trustworthy. 17 | 18 | -} 19 | {-# LANGUAGE Trustworthy #-} 20 | #endif 21 | 22 | -- For the IsList and IsString instances 23 | {-# LANGUAGE TypeFamilies #-} 24 | 25 | ----------------------------------------------------------------------------- 26 | 27 | {-| 28 | 29 | Module: Data.DList.DNonEmpty.Internal 30 | Copyright: © 2017-2020 Oleg Grenrus, 2020 Sean Leather 31 | License: BSD-3-Clause 32 | 33 | Maintainer: sean.leather@gmail.com 34 | Stability: stable 35 | 36 | This module includes everything related to 'DNonEmpty' and is not exposed to 37 | users of the @dlist@ package. 38 | 39 | -} 40 | {- ORMOLU_ENABLE -} 41 | 42 | module Data.DList.DNonEmpty.Internal where 43 | 44 | ----------------------------------------------------------------------------- 45 | 46 | import qualified Control.Applicative as Applicative 47 | import Control.DeepSeq (NFData (..)) 48 | import qualified Control.Monad as Monad 49 | import Data.DList (DList) 50 | import qualified Data.DList as DList 51 | import qualified Data.Foldable as Foldable 52 | import Data.Function (on) 53 | import Data.List.NonEmpty (NonEmpty) 54 | import qualified Data.List.NonEmpty as NonEmpty 55 | import qualified Data.Semigroup as Semigroup 56 | import Data.String (IsString (..)) 57 | import qualified GHC.Exts as Exts 58 | import qualified Text.Read as Read 59 | import Prelude hiding (head, map, tail) 60 | 61 | ----------------------------------------------------------------------------- 62 | 63 | {- ORMOLU_DISABLE -} 64 | {-| 65 | 66 | A non-empty difference list is a pair of a 'head' element and a (possibly empty) 67 | difference list. 68 | 69 | Just as 'DList' is a representation of a list, so is @DNonEmpty@ a 70 | representation of a 'NonEmpty'. @DNonEmpty@ supports \(\mathcal{O}\)(@1@) 71 | 'append' and 'snoc' operations, making it useful for replacing frequent 72 | applications of 'Semigroup.<>' on 'NonEmpty' (which is implemented with '++'), 73 | especially if those uses are left-nested (e.g. @(a __'Semigroup.<>'__ b) 74 | 'Semigroup.<>' c@ ). 75 | 76 | Unlike 'DList', @DNonEmpty@ is not an abstract type: its constructor is 77 | exported. An alternative definition of @DNonEmpty@ is: 78 | 79 | @ 80 | newtype DNonEmpty a = DNonEmpty ([a] -> 'NonEmpty' a) 81 | @ 82 | 83 | This type would need to be abstract to avoid producing @DNonEmpty@ values that 84 | are not isomorphic to 'NonEmpty' values. However, this type would also require 85 | some functions (such as 'map') to be implemented with 'fromNonEmpty' (and thus 86 | '++'), which could introduce efficiencies. 87 | 88 | -} 89 | {- ORMOLU_ENABLE -} 90 | 91 | infixr 5 :| 92 | 93 | data DNonEmpty a = a :| DList a 94 | 95 | {- ORMOLU_DISABLE -} 96 | {-| 97 | 98 | __@fromNonEmpty xs@__ is a 'DNonEmpty' representing the 'NonEmpty' __@xs@__. 99 | 100 | @fromNonEmpty@ obeys the laws: 101 | 102 | @ 103 | 'toNonEmpty' . __fromNonEmpty__ = 'id' 104 | __fromNonEmpty__ . 'toNonEmpty' = 'id' 105 | @ 106 | 107 | As with 'DList.fromList', this function is implemented with '++'. Repeated uses 108 | of @fromNonEmpty@ are just as inefficient as repeated uses of '++'. If you find 109 | yourself doing some form of the following (possibly indirectly), you may not be 110 | taking advantage of the 'DNonEmpty' representation and library: 111 | 112 | @ 113 | __fromNonEmpty__ . f . 'toNonEmpty' 114 | @ 115 | 116 | More likely, you will convert from a 'NonEmpty', perform some operation on the 117 | 'DNonEmpty', and convert back to a 'NonEmpty': 118 | 119 | @ 120 | 'toNonEmpty' . g . __fromNonEmpty__ 121 | @ 122 | 123 | -} 124 | {- ORMOLU_ENABLE -} 125 | 126 | {-# INLINE fromNonEmpty #-} 127 | fromNonEmpty :: NonEmpty a -> DNonEmpty a 128 | fromNonEmpty ~(x NonEmpty.:| xs) = x :| DList.fromList xs 129 | 130 | {- ORMOLU_DISABLE -} 131 | {-| 132 | 133 | __@toNonEmpty xs@__ is the 'NonEmpty' represented by __@xs@__. 134 | 135 | @toNonEmpty@ obeys the laws: 136 | 137 | @ 138 | __toNonEmpty__ . 'fromNonEmpty' = 'id' 139 | 'fromNonEmpty' . __toNonEmpty__ = 'id' 140 | @ 141 | 142 | As with 'DList.toList', evaluating @toNonEmpty xs@ may “collapse” the chain of 143 | function composition underlying many 'DList' functions ('DList.append' in 144 | particular) used to construct the 'tail' of @xs@. This may affect any efficiency 145 | you achieved due to laziness in the construction. 146 | 147 | -} 148 | {- ORMOLU_ENABLE -} 149 | 150 | {-# INLINE toNonEmpty #-} 151 | toNonEmpty :: DNonEmpty a -> NonEmpty a 152 | toNonEmpty ~(x :| xs) = x NonEmpty.:| DList.toList xs 153 | 154 | {- ORMOLU_DISABLE -} 155 | {-| 156 | 157 | __@toDList xs@__ is the non-empty 'DList' represented by __@xs@__. 158 | 159 | @toDList@ obeys the law: 160 | 161 | @ 162 | __toDList__ (x ':|' xs) = 'DList.cons' x xs 163 | @ 164 | 165 | Note that this function is used only in this module. 166 | 167 | -} 168 | {- ORMOLU_ENABLE -} 169 | 170 | toDList :: DNonEmpty a -> DList a 171 | toDList ~(x :| xs) = DList.cons x xs 172 | 173 | {- ORMOLU_DISABLE -} 174 | {-| 175 | 176 | __@toList xs@__ is the non-empty list represented by __@xs@__. 177 | 178 | @toList@ obeys the law: 179 | 180 | @ 181 | __toList__ xs = 'NonEmpty.toList' ('toNonEmpty' xs) 182 | @ 183 | 184 | -} 185 | {- ORMOLU_ENABLE -} 186 | 187 | {-# INLINE toList #-} 188 | toList :: DNonEmpty a -> [a] 189 | toList = DList.toList . toDList 190 | 191 | {- ORMOLU_DISABLE -} 192 | {-| 193 | 194 | __@fromList xs@__ is a 'DNonEmpty' representing the list __@xs@__. If @xs@ is 195 | empty, an 'error' is raised. 196 | 197 | @fromList@ obeys the law: 198 | 199 | @ 200 | __fromList__ xs = 'fromNonEmpty' ('NonEmpty.fromList' xs) 201 | @ 202 | 203 | -} 204 | {- ORMOLU_ENABLE -} 205 | 206 | fromList :: [a] -> DNonEmpty a 207 | fromList (x : xs) = x :| DList.fromList xs 208 | fromList [] = error "Data.DList.DNonEmpty.fromList: empty list" 209 | 210 | {- ORMOLU_DISABLE -} 211 | {-| 212 | 213 | __@singleton x@__ is a 'DNonEmpty' with the single element __@x@__. 214 | 215 | @singleton@ obeys the law: 216 | 217 | @ 218 | 'toNonEmpty' (__singleton__ x) = x 'NonEmpty.:|' [] 219 | @ 220 | 221 | -} 222 | {- ORMOLU_ENABLE -} 223 | 224 | {-# INLINE singleton #-} 225 | singleton :: a -> DNonEmpty a 226 | singleton x = x :| DList.empty 227 | 228 | {- ORMOLU_DISABLE -} 229 | {-| 230 | 231 | __@cons x xs@__ is a 'DNonEmpty' with the 'head' __@x@__ and the 'tail' __@xs@__. 232 | 233 | \(\mathcal{O}\)(@1@). 234 | 235 | @cons@ obeys the law: 236 | 237 | @ 238 | 'toNonEmpty' (__cons__ x xs) = 'NonEmpty.cons' x ('toNonEmpty' xs) 239 | @ 240 | 241 | -} 242 | {- ORMOLU_ENABLE -} 243 | 244 | infixr 9 `cons` 245 | 246 | {-# INLINE cons #-} 247 | cons :: a -> DNonEmpty a -> DNonEmpty a 248 | cons x ~(y :| ys) = x :| DList.cons y ys 249 | 250 | infixl 9 `snoc` 251 | 252 | {- ORMOLU_DISABLE -} 253 | {-| 254 | 255 | __@snoc xs x@__ is a 'DNonEmpty' with the initial 'DNonEmpty' __@xs@__ and the 256 | last element __@x@__. 257 | 258 | \(\mathcal{O}\)(@1@). 259 | 260 | @snoc@ obeys the law: 261 | 262 | @ 263 | 'toNonEmpty' (__snoc__ xs x) = 'toNonEmpty' xs 'Semigroup.<>' (x 'NonEmpty.:|' []) 264 | @ 265 | 266 | -} 267 | {- ORMOLU_ENABLE -} 268 | 269 | {-# INLINE snoc #-} 270 | snoc :: DNonEmpty a -> a -> DNonEmpty a 271 | snoc ~(x :| xs) y = x :| DList.snoc xs y 272 | 273 | {- ORMOLU_DISABLE -} 274 | {-| 275 | 276 | __@append xs ys@__ is a 'DNonEmpty' obtained from the concatenation of the 277 | elements of __@xs@__ and __@ys@__. 278 | 279 | \(\mathcal{O}\)(@1@). 280 | 281 | @append@ obeys the law: 282 | 283 | @ 284 | 'toNonEmpty' (__append__ xs ys) = 'toNonEmpty' xs 'Semigroup.<>' 'toNonEmpty' ys 285 | @ 286 | 287 | -} 288 | {- ORMOLU_ENABLE -} 289 | 290 | {-# INLINE append #-} 291 | append :: DNonEmpty a -> DNonEmpty a -> DNonEmpty a 292 | append (x :| xs) ~(y :| ys) = x :| DList.append xs (DList.cons y ys) 293 | 294 | {- ORMOLU_DISABLE -} 295 | {-| 296 | 297 | __@head xs@__ is the first element of __@xs@__. 298 | 299 | \(\mathcal{O}\)(@1@). 300 | 301 | @head@ obeys the law: 302 | 303 | @ 304 | __head__ xs = 'NonEmpty.head' ('toNonEmpty' xs) 305 | @ 306 | 307 | -} 308 | {- ORMOLU_ENABLE -} 309 | 310 | {-# INLINE head #-} 311 | head :: DNonEmpty a -> a 312 | head ~(x :| _) = x 313 | 314 | {- ORMOLU_DISABLE -} 315 | {-| 316 | 317 | __@tail xs@__ is a 'DList' of the elements in __@xs@__ excluding the first 318 | element. 319 | 320 | \(\mathcal{O}\)(@1@). 321 | 322 | @tail@ obeys the law: 323 | 324 | @ 325 | 'DList.toList' (__tail__ xs) = 'NonEmpty.tail' ('toNonEmpty' xs) 326 | @ 327 | 328 | -} 329 | {- ORMOLU_ENABLE -} 330 | 331 | {-# INLINE tail #-} 332 | tail :: DNonEmpty a -> DList a 333 | tail ~(_ :| xs) = xs 334 | 335 | {- ORMOLU_DISABLE -} 336 | {-| 337 | 338 | __@unfoldr f z@__ is the 'DNonEmpty' constructed from the recursive application 339 | of __@f@__. The recursion starts with the seed value __@z@__ and ends when, for 340 | some @z' : b@, @f z' == 'Nothing'@. 341 | 342 | \(\mathcal{O}\)(@'NonEmpty.length' ('NonEmpty.unfoldr' f z)@). 343 | 344 | @unfoldr@ obeys the law: 345 | 346 | @ 347 | 'toNonEmpty' (__unfoldr__ f z) = 'NonEmpty.unfoldr' f z 348 | @ 349 | 350 | -} 351 | {- ORMOLU_ENABLE -} 352 | 353 | unfoldr :: (b -> (a, Maybe b)) -> b -> DNonEmpty a 354 | unfoldr f z = 355 | case f z of 356 | (x, Nothing) -> singleton x 357 | (x, Just z') -> cons x $ unfoldr f z' 358 | 359 | {- ORMOLU_DISABLE -} 360 | {-| 361 | 362 | __@map f xs@__ is the 'DNonEmpty' obtained by applying __@f@__ to each element 363 | of __@xs@__. 364 | 365 | \(\mathcal{O}\)(@'NonEmpty.length' ('toNonEmpty' xs)@). 366 | 367 | @map@ obeys the law: 368 | 369 | @ 370 | 'toNonEmpty' (__map__ f xs) = 'NonEmpty.map' f ('toNonEmpty' xs) 371 | @ 372 | 373 | -} 374 | {- ORMOLU_ENABLE -} 375 | 376 | {-# INLINE map #-} 377 | map :: (a -> b) -> DNonEmpty a -> DNonEmpty b 378 | map f ~(x :| xs) = f x :| DList.map f xs 379 | 380 | instance Eq a => Eq (DNonEmpty a) where 381 | (==) = (==) `on` toNonEmpty 382 | 383 | instance Ord a => Ord (DNonEmpty a) where 384 | compare = compare `on` toNonEmpty 385 | 386 | instance Read a => Read (DNonEmpty a) where 387 | readPrec = Read.parens $ 388 | Read.prec 10 $ do 389 | Read.Ident "fromNonEmpty" <- Read.lexP 390 | dl <- Read.readPrec 391 | return $ fromNonEmpty dl 392 | readListPrec = Read.readListPrecDefault 393 | 394 | instance Show a => Show (DNonEmpty a) where 395 | showsPrec p dl = 396 | showParen (p > 10) $ 397 | showString "fromNonEmpty " . showsPrec 11 (toNonEmpty dl) 398 | 399 | instance Functor DNonEmpty where 400 | {-# INLINE fmap #-} 401 | fmap = map 402 | 403 | instance Applicative.Applicative DNonEmpty where 404 | {-# INLINE pure #-} 405 | pure = singleton 406 | 407 | {-# INLINE (<*>) #-} 408 | (<*>) = Monad.ap 409 | 410 | instance Monad DNonEmpty where 411 | ~(x :| xs) >>= k = y :| DList.append ys (xs >>= toDList . k) 412 | where 413 | y :| ys = k x 414 | 415 | {-# INLINE return #-} 416 | return = Applicative.pure 417 | 418 | instance Foldable.Foldable DNonEmpty where 419 | {-# INLINE fold #-} 420 | fold = Foldable.fold . toNonEmpty 421 | 422 | {-# INLINE foldMap #-} 423 | foldMap f = Foldable.foldMap f . toNonEmpty 424 | 425 | {-# INLINE foldr #-} 426 | foldr f x = Foldable.foldr f x . toNonEmpty 427 | 428 | {-# INLINE foldl #-} 429 | foldl f x = Foldable.foldl f x . toNonEmpty 430 | 431 | {-# INLINE foldr1 #-} 432 | foldr1 f = Foldable.foldr1 f . toNonEmpty 433 | 434 | {-# INLINE foldl1 #-} 435 | foldl1 f = Foldable.foldl1 f . toNonEmpty 436 | 437 | {-# INLINE foldl' #-} 438 | foldl' f x = Foldable.foldl' f x . toNonEmpty 439 | 440 | {-# INLINE foldr' #-} 441 | foldr' f x = Foldable.foldr' f x . toNonEmpty 442 | 443 | {-# INLINE toList #-} 444 | toList = toList 445 | 446 | instance NFData a => NFData (DNonEmpty a) where 447 | {-# INLINE rnf #-} 448 | rnf = rnf . toNonEmpty 449 | 450 | {- 451 | 452 | The 'IsString' instance is _not_ a flexible instance to allow certain uses of 453 | overloaded strings. See tests/OverloadedStrings.hs for an example and 454 | https://gitlab.haskell.org/ghc/ghc/-/commit/b225b234a6b11e42fef433dcd5d2a38bb4b466bf 455 | for the same change made to the IsString instance for lists. 456 | 457 | -} 458 | 459 | instance a ~ Char => IsString (DNonEmpty a) where 460 | {-# INLINE fromString #-} 461 | fromString = fromList 462 | 463 | instance Exts.IsList (DNonEmpty a) where 464 | type Item (DNonEmpty a) = a 465 | 466 | {-# INLINE fromList #-} 467 | fromList = fromList 468 | 469 | {-# INLINE toList #-} 470 | toList = toList 471 | 472 | instance Semigroup.Semigroup (DNonEmpty a) where 473 | {-# INLINE (<>) #-} 474 | (<>) = append 475 | -------------------------------------------------------------------------------- /Data/DList/Internal.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | -- Options passed to GHC 3 | {-# OPTIONS_GHC -O2 #-} 4 | -- Options passed to Haddock 5 | {-# OPTIONS_HADDOCK hide #-} 6 | 7 | ----------------------------------------------------------------------------- 8 | 9 | {-# LANGUAGE CPP #-} 10 | 11 | {- 12 | 13 | We use __GLASGOW_HASKELL__ everywhere, so, rather than check if it's defined in 14 | multiple places, we assert an error here if it is not. Since the rest of the 15 | package depends on this module ('Data.DList.Internal'), we don't perform the 16 | same check everywhere else. 17 | 18 | -} 19 | #if !defined(__GLASGOW_HASKELL__) 20 | #error "Your compiler is not GHC. Let us know if dlist can be made to work on it." 21 | #endif 22 | 23 | -- For the IsList and IsString instances 24 | {-# LANGUAGE TypeFamilies #-} 25 | 26 | -- CPP: GHC >= 7.8 for pattern synonyms, Safe Haskell, view patterns 27 | #if __GLASGOW_HASKELL__ >= 708 28 | {- ORMOLU_ENABLE -} 29 | {-# LANGUAGE PatternSynonyms #-} 30 | {- 31 | 32 | The 'Data.DList.Internal' module exports 'UnsafeDList' and 'unsafeApplyDList', 33 | which allow breaking the invariant of the 'DList' newtype. Therefore, we 34 | explicitly mark 'Data.DList.Internal' as unsafe. 35 | 36 | -} 37 | {-# LANGUAGE Unsafe #-} 38 | {-# LANGUAGE ViewPatterns #-} 39 | {- ORMOLU_DISABLE -} 40 | #endif 41 | 42 | ----------------------------------------------------------------------------- 43 | 44 | {-| 45 | 46 | Module: Data.DList.Internal 47 | Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather 48 | License: BSD-3-Clause 49 | 50 | Maintainer: sean.leather@gmail.com 51 | Stability: stable 52 | 53 | This module includes everything related to 'DList' and is not exposed to users 54 | of the @dlist@ package. 55 | 56 | -} 57 | {- ORMOLU_ENABLE -} 58 | 59 | module Data.DList.Internal where 60 | 61 | ----------------------------------------------------------------------------- 62 | 63 | import qualified Control.Applicative as Applicative 64 | import Control.DeepSeq (NFData (..)) 65 | import qualified Control.Monad as Monad 66 | -- CPP: base >= 4.9 for MonadFail 67 | -- CPP: base >= 4.13 for MonadFail exported from Control.Monad 68 | #if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0) 69 | import qualified Control.Monad.Fail as Monad 70 | #endif 71 | import qualified Data.Foldable as Foldable 72 | import Data.Function (on) 73 | import qualified Data.List as List 74 | import qualified Data.Monoid as Monoid 75 | -- CPP: base >= 4.9 for Semigroup 76 | #if MIN_VERSION_base(4,9,0) 77 | import qualified Data.Semigroup as Semigroup 78 | #endif 79 | import Data.String (IsString (..)) 80 | import qualified Data.Traversable as Traversable 81 | -- CPP: GHC >= 7.8 for IsList 82 | #if __GLASGOW_HASKELL__ >= 708 83 | import qualified GHC.Exts as Exts 84 | #endif 85 | import qualified Text.Read as Read 86 | import Prelude hiding (concat, foldr, head, map, replicate, tail) 87 | 88 | ----------------------------------------------------------------------------- 89 | 90 | {- ORMOLU_DISABLE -} 91 | {-| 92 | 93 | A difference list is an abstraction representing a list that 94 | supports \(\mathcal{O}\)(@1@) 'append' and 'snoc' operations, making it 95 | useful for replacing frequent applications of '++' such as logging and pretty 96 | printing (esp. if those uses of '++' are left-nested). 97 | 98 | -} 99 | {- ORMOLU_ENABLE -} 100 | 101 | newtype DList a = UnsafeDList {unsafeApplyDList :: [a] -> [a]} 102 | 103 | {- ORMOLU_DISABLE -} 104 | {-| 105 | 106 | __@fromList xs@__ is a 'DList' representing the list __@xs@__. 107 | 108 | @fromList@ obeys the laws: 109 | 110 | @ 111 | 'toList' . __fromList__ = 'id' 112 | __fromList__ . 'toList' = 'id' 113 | @ 114 | 115 | This function is implemented with '++'. Repeated uses of @fromList@ are just as 116 | inefficient as repeated uses of '++'. If you find yourself doing some form of 117 | the following (possibly indirectly), you may not be taking advantage of the 118 | 'DList' representation and library: 119 | 120 | @ 121 | __fromList__ . f . 'toList' 122 | @ 123 | 124 | More likely, you will convert from a list, perform some operation on the 125 | 'DList', and convert back to a list: 126 | 127 | @ 128 | 'toList' . g . __fromList__ 129 | @ 130 | 131 | -} 132 | {- ORMOLU_ENABLE -} 133 | 134 | {-# INLINE fromList #-} 135 | fromList :: [a] -> DList a 136 | fromList = UnsafeDList . (++) 137 | 138 | {- ORMOLU_DISABLE -} 139 | {-| 140 | 141 | __@toList xs@__ is the list represented by __@xs@__. 142 | 143 | @toList@ obeys the laws: 144 | 145 | @ 146 | __toList__ . 'fromList' = 'id' 147 | 'fromList' . __toList__ = 'id' 148 | @ 149 | 150 | Evaluating @toList xs@ may “collapse” the chain of function composition 151 | underlying many 'DList' functions ('append' in particular) used to construct 152 | @xs@. This may affect any efficiency you achieved due to laziness in the 153 | construction. 154 | 155 | -} 156 | {- ORMOLU_ENABLE -} 157 | 158 | {-# INLINE toList #-} 159 | toList :: DList a -> [a] 160 | toList = ($ []) . unsafeApplyDList 161 | 162 | -- CPP: GHC >= 7.8 for pattern synonyms 163 | #if __GLASGOW_HASKELL__ >= 708 164 | 165 | -- CPP: GHC >= 7.10 for pattern synonym signatures 166 | 167 | {- ORMOLU_DISABLE -} 168 | {-| 169 | 170 | A unidirectional pattern synonym for 'empty'. This is implemented with 'toList'. 171 | 172 | -} 173 | {- ORMOLU_ENABLE -} 174 | 175 | #if __GLASGOW_HASKELL__ >= 710 176 | pattern Nil :: DList a 177 | #endif 178 | pattern Nil <- (toList -> []) 179 | 180 | {- ORMOLU_DISABLE -} 181 | {-| 182 | 183 | A unidirectional pattern synonym for 'cons'. This is implemented with 'toList'. 184 | 185 | -} 186 | {- ORMOLU_ENABLE -} 187 | 188 | #if __GLASGOW_HASKELL__ >= 710 189 | pattern Cons :: a -> [a] -> DList a 190 | #endif 191 | pattern Cons x xs <- (toList -> x : xs) 192 | 193 | #endif 194 | 195 | {- ORMOLU_DISABLE -} 196 | {-| 197 | 198 | __@apply xs ys@__ is the list represented by the __@xs@__ after appending 199 | __@ys@__ to it. 200 | 201 | \(\mathcal{O}\)(@1@). 202 | 203 | @apply@ obeys the law: 204 | 205 | @ 206 | __apply__ xs ys = 'toList' xs '++' ys 207 | @ 208 | 209 | -} 210 | {- ORMOLU_ENABLE -} 211 | 212 | {-# INLINE apply #-} 213 | apply :: DList a -> [a] -> [a] 214 | apply = unsafeApplyDList 215 | 216 | {- ORMOLU_DISABLE -} 217 | {-| 218 | 219 | __@empty@__ is a 'DList' with no elements. 220 | 221 | @empty@ obeys the law: 222 | 223 | @ 224 | 'toList' __empty__ = [] 225 | @ 226 | 227 | -} 228 | {- ORMOLU_ENABLE -} 229 | 230 | {-# INLINE empty #-} 231 | empty :: DList a 232 | empty = UnsafeDList id 233 | 234 | {- ORMOLU_DISABLE -} 235 | {-| 236 | 237 | __@singleton x@__ is a 'DList' with the single element __@x@__. 238 | 239 | @singleton@ obeys the law: 240 | 241 | @ 242 | 'toList' (__singleton__ x) = [x] 243 | @ 244 | 245 | -} 246 | {- ORMOLU_ENABLE -} 247 | 248 | {-# INLINE singleton #-} 249 | singleton :: a -> DList a 250 | singleton = UnsafeDList . (:) 251 | 252 | {- ORMOLU_DISABLE -} 253 | {-| 254 | 255 | __@cons x xs@__ is a 'DList' with the 'head' __@x@__ and the 'tail' __@xs@__. 256 | 257 | \(\mathcal{O}\)(@1@). 258 | 259 | @cons@ obeys the law: 260 | 261 | @ 262 | 'toList' (__cons__ x xs) = x : 'toList' xs 263 | @ 264 | 265 | -} 266 | {- ORMOLU_ENABLE -} 267 | 268 | infixr 9 `cons` 269 | 270 | {-# INLINE cons #-} 271 | cons :: a -> DList a -> DList a 272 | cons x xs = UnsafeDList $ (x :) . unsafeApplyDList xs 273 | 274 | infixl 9 `snoc` 275 | 276 | {- ORMOLU_DISABLE -} 277 | {-| 278 | 279 | __@snoc xs x@__ is a 'DList' with the initial 'DList' __@xs@__ and the last 280 | element __@x@__. 281 | 282 | \(\mathcal{O}\)(@1@). 283 | 284 | @snoc@ obeys the law: 285 | 286 | @ 287 | 'toList' (__snoc__ xs x) = 'toList' xs '++' [x] 288 | @ 289 | 290 | -} 291 | {- ORMOLU_ENABLE -} 292 | 293 | {-# INLINE snoc #-} 294 | snoc :: DList a -> a -> DList a 295 | snoc xs x = UnsafeDList $ unsafeApplyDList xs . (x :) 296 | 297 | {- ORMOLU_DISABLE -} 298 | {-| 299 | 300 | __@append xs ys@__ is a 'DList' obtained from the concatenation of the elements 301 | of __@xs@__ and __@ys@__. 302 | 303 | \(\mathcal{O}\)(@1@). 304 | 305 | @append@ obeys the law: 306 | 307 | @ 308 | 'toList' (__append__ xs ys) = 'toList' xs '++' 'toList' ys 309 | @ 310 | 311 | -} 312 | {- ORMOLU_ENABLE -} 313 | 314 | {-# INLINE append #-} 315 | append :: DList a -> DList a -> DList a 316 | append xs ys = UnsafeDList $ unsafeApplyDList xs . unsafeApplyDList ys 317 | 318 | {- ORMOLU_DISABLE -} 319 | {-| 320 | 321 | __@concat xss@__ is a 'DList' representing the concatenation of all 'DList's in 322 | the list __@xss@__. 323 | 324 | \(\mathcal{O}\)(@'length' xss@). 325 | 326 | @concat@ obeys the law: 327 | 328 | @ 329 | 'toList' (__concat__ xss) = 'List.concat' ('List.map' 'toList' xss) 330 | @ 331 | 332 | -} 333 | {- ORMOLU_ENABLE -} 334 | 335 | {-# INLINE concat #-} 336 | concat :: [DList a] -> DList a 337 | concat = List.foldr append empty 338 | 339 | {- ORMOLU_DISABLE -} 340 | {-| 341 | 342 | __@replicate n x@__ is a 'DList' of length __@n@__ with __@x@__ as the value of 343 | every element. 344 | 345 | \(\mathcal{O}\)(@n@). 346 | 347 | @replicate@ obeys the law: 348 | 349 | @ 350 | 'toList' (__replicate__ n x) = 'List.replicate' n x 351 | @ 352 | 353 | -} 354 | {- ORMOLU_ENABLE -} 355 | 356 | {-# INLINE replicate #-} 357 | replicate :: Int -> a -> DList a 358 | replicate n x = UnsafeDList $ \xs -> 359 | let go m 360 | | m <= 0 = xs 361 | | otherwise = x : go (m -1) 362 | in go n 363 | 364 | {- ORMOLU_DISABLE -} 365 | {-| 366 | 367 | __@head xs@__ is the first element of __@xs@__. If @xs@ is empty, an 'error' is 368 | raised. 369 | 370 | \(\mathcal{O}\)(@1@). 371 | 372 | @head@ obeys the law: 373 | 374 | @ 375 | __head__ xs = 'List.head' ('toList' xs) 376 | @ 377 | 378 | -} 379 | {- ORMOLU_ENABLE -} 380 | 381 | {-# INLINE head #-} 382 | head :: DList a -> a 383 | head xs = case toList xs of 384 | x : _ -> x 385 | [] -> error "Data.DList.head: empty DList" 386 | 387 | {- ORMOLU_DISABLE -} 388 | {-| 389 | 390 | __@tail xs@__ is a list of the elements in __@xs@__ excluding the first element. 391 | If @xs@ is empty, an 'error' is raised. 392 | 393 | \(\mathcal{O}\)(@'length' ('toList' xs)@). 394 | 395 | @tail@ obeys the law: 396 | 397 | @ 398 | __tail__ xs = 'List.tail' ('toList' xs) 399 | @ 400 | 401 | -} 402 | {- ORMOLU_ENABLE -} 403 | 404 | {-# INLINE tail #-} 405 | tail :: DList a -> [a] 406 | tail xs = case toList xs of 407 | _ : ys -> ys 408 | [] -> error "Data.DList.tail: empty DList" 409 | 410 | {- ORMOLU_DISABLE -} 411 | {-| 412 | 413 | __@unfoldr f z@__ is the 'DList' constructed from the recursive application of 414 | __@f@__. The recursion starts with the seed value __@z@__ and ends when, for 415 | some @z' : b@, @f z' == 'Nothing'@. 416 | 417 | \(\mathcal{O}\)(@'length' ('List.unfoldr' f z)@). 418 | 419 | @unfoldr@ obeys the law: 420 | 421 | @ 422 | 'toList' (__unfoldr__ f z) = 'List.unfoldr' f z 423 | @ 424 | 425 | -} 426 | {- ORMOLU_ENABLE -} 427 | 428 | unfoldr :: (b -> Maybe (a, b)) -> b -> DList a 429 | unfoldr f z = 430 | case f z of 431 | Nothing -> empty 432 | Just (x, z') -> cons x $ unfoldr f z' 433 | 434 | {- ORMOLU_DISABLE -} 435 | {-| 436 | 437 | __@foldr f z xs@__ is the right-fold of __@f@__ over __@xs@__. 438 | 439 | \(\mathcal{O}\)(@'length' ('toList' xs)@). 440 | 441 | @foldr@ obeys the law: 442 | 443 | @ 444 | __foldr__ f z xs = 'List.foldr' f z ('toList' xs) 445 | @ 446 | 447 | -} 448 | {- ORMOLU_ENABLE -} 449 | 450 | {-# INLINE foldr #-} 451 | foldr :: (a -> b -> b) -> b -> DList a -> b 452 | foldr f z = List.foldr f z . toList 453 | 454 | {- ORMOLU_DISABLE -} 455 | {-| 456 | 457 | __@map f xs@__ is the 'DList' obtained by applying __@f@__ to each element of 458 | __@xs@__. 459 | 460 | \(\mathcal{O}\)(@'length' ('toList' xs)@). 461 | 462 | @map@ obeys the law: 463 | 464 | @ 465 | 'toList' (__map__ f xs) = 'List.map' f ('toList' xs) 466 | @ 467 | 468 | -} 469 | {- ORMOLU_ENABLE -} 470 | 471 | {-# INLINE map #-} 472 | map :: (a -> b) -> DList a -> DList b 473 | map f = foldr (cons . f) empty 474 | 475 | {- ORMOLU_DISABLE -} 476 | {-| 477 | 478 | __@intercalate xs xss@__ is the concatenation of __@xss@__ after the insertion 479 | of __@xs@__ between every pair of 480 | elements. 481 | 482 | \(\mathcal{O}\)(@'length' xss@). 483 | 484 | @intercalate@ obeys the law: 485 | 486 | @ 487 | 'toList' (__intercalate__ xs xss) = 'List.intercalate' ('toList' xs) ('map' 'toList' xss) 488 | @ 489 | 490 | -} 491 | {- ORMOLU_ENABLE -} 492 | 493 | {-# INLINE intercalate #-} 494 | intercalate :: DList a -> [DList a] -> DList a 495 | intercalate sep = concat . List.intersperse sep 496 | 497 | instance Eq a => Eq (DList a) where 498 | (==) = (==) `on` toList 499 | 500 | instance Ord a => Ord (DList a) where 501 | compare = compare `on` toList 502 | 503 | -- The 'Read' and 'Show' instances were adapted from 'Data.Sequence'. 504 | 505 | instance Read a => Read (DList a) where 506 | readPrec = Read.parens $ 507 | Read.prec 10 $ do 508 | Read.Ident "fromList" <- Read.lexP 509 | dl <- Read.readPrec 510 | return (fromList dl) 511 | readListPrec = Read.readListPrecDefault 512 | 513 | instance Show a => Show (DList a) where 514 | showsPrec p dl = 515 | showParen (p > 10) $ 516 | showString "fromList " . shows (toList dl) 517 | 518 | instance Monoid.Monoid (DList a) where 519 | {-# INLINE mempty #-} 520 | mempty = empty 521 | 522 | -- CPP: base >= 4.11 for Semigroup as a superclass of Monoid 523 | #if MIN_VERSION_base(4,11,0) 524 | 525 | #else 526 | 527 | {-# INLINE mappend #-} 528 | -- CPP: base >= 4.9 for Semigroup in base 529 | #if MIN_VERSION_base(4,9,0) 530 | -- Canonical definition 531 | mappend = (Semigroup.<>) 532 | #else 533 | mappend = append 534 | #endif 535 | 536 | #endif 537 | 538 | instance Functor DList where 539 | {-# INLINE fmap #-} 540 | fmap = map 541 | 542 | instance Applicative.Applicative DList where 543 | {-# INLINE pure #-} 544 | pure = singleton 545 | 546 | {-# INLINE (<*>) #-} 547 | (<*>) = Monad.ap 548 | 549 | instance Applicative.Alternative DList where 550 | {-# INLINE empty #-} 551 | empty = empty 552 | 553 | {-# INLINE (<|>) #-} 554 | (<|>) = append 555 | 556 | instance Monad DList where 557 | {-# INLINE (>>=) #-} 558 | m >>= k = 559 | -- = concat (toList (fmap k m)) 560 | -- = (concat . toList . fromList . List.map k . toList) m 561 | -- = concat . List.map k . toList $ m 562 | -- = List.foldr append empty . List.map k . toList $ m 563 | -- = List.foldr (append . k) empty . toList $ m 564 | foldr (append . k) empty m 565 | 566 | {-# INLINE return #-} 567 | return = Applicative.pure 568 | 569 | -- CPP: base < 4.13 for fail in Monad 570 | #if !MIN_VERSION_base(4,13,0) 571 | {-# INLINE fail #-} 572 | fail _ = empty 573 | #endif 574 | 575 | -- CPP: base >= 4.9 for MonadFail 576 | #if MIN_VERSION_base(4,9,0) 577 | instance Monad.MonadFail DList where 578 | {-# INLINE fail #-} 579 | fail _ = empty 580 | #endif 581 | 582 | instance Monad.MonadPlus DList where 583 | {-# INLINE mzero #-} 584 | mzero = empty 585 | 586 | {-# INLINE mplus #-} 587 | mplus = append 588 | 589 | instance Foldable.Foldable DList where 590 | {-# INLINE fold #-} 591 | fold = Monoid.mconcat . toList 592 | 593 | {-# INLINE foldMap #-} 594 | foldMap f = Foldable.foldMap f . toList 595 | 596 | {-# INLINE foldr #-} 597 | foldr f x = List.foldr f x . toList 598 | 599 | {-# INLINE foldl #-} 600 | foldl f x = List.foldl f x . toList 601 | 602 | {-# INLINE foldr1 #-} 603 | foldr1 f = List.foldr1 f . toList 604 | 605 | {-# INLINE foldl1 #-} 606 | foldl1 f = List.foldl1 f . toList 607 | 608 | -- CPP: GHC >= 7.6 for foldl', foldr' in Foldable 609 | #if __GLASGOW_HASKELL__ >= 706 610 | {-# INLINE foldl' #-} 611 | foldl' f x = List.foldl' f x . toList 612 | 613 | {-# INLINE foldr' #-} 614 | foldr' f x = Foldable.foldr' f x . toList 615 | #endif 616 | 617 | -- CPP: base >= 4.8 for toList in Foldable 618 | #if MIN_VERSION_base(4,8,0) 619 | {-# INLINE toList #-} 620 | toList = Data.DList.Internal.toList 621 | #endif 622 | 623 | instance Traversable.Traversable DList where 624 | {-# INLINE traverse #-} 625 | traverse f = foldr cons_f (Applicative.pure empty) 626 | where 627 | cons_f x = Applicative.liftA2 cons (f x) 628 | 629 | instance NFData a => NFData (DList a) where 630 | {-# INLINE rnf #-} 631 | rnf = rnf . toList 632 | 633 | {- 634 | 635 | The 'IsString' instance is _not_ a flexible instance to allow certain uses of 636 | overloaded strings. See tests/OverloadedStrings.hs for an example and 637 | https://gitlab.haskell.org/ghc/ghc/-/commit/b225b234a6b11e42fef433dcd5d2a38bb4b466bf 638 | for the same change made to the IsString instance for lists. 639 | 640 | -} 641 | 642 | instance a ~ Char => IsString (DList a) where 643 | {-# INLINE fromString #-} 644 | fromString = fromList 645 | 646 | -- CPP: GHC >= 7.8 for IsList 647 | #if __GLASGOW_HASKELL__ >= 708 648 | instance Exts.IsList (DList a) where 649 | type Item (DList a) = a 650 | 651 | {-# INLINE fromList #-} 652 | fromList = fromList 653 | 654 | {-# INLINE toList #-} 655 | toList = toList 656 | #endif 657 | 658 | {- 659 | 660 | We use 'compare n 0' in the definition of 'Semigroup.stimes' since the same 661 | expression is used in 'Semigroup.stimesMonoid' and we should get a lazy 662 | advantage. However, we prefer the error to be sourced here instead of 663 | 'Semigroup.stimesMonoid'. 664 | 665 | -} 666 | 667 | -- CPP: base >= 4.9 for Semigroup 668 | #if MIN_VERSION_base(4,9,0) 669 | instance Semigroup.Semigroup (DList a) where 670 | {-# INLINE (<>) #-} 671 | (<>) = append 672 | 673 | stimes n = case compare n 0 of 674 | LT -> error "Data.DList.stimes: negative multiplier" 675 | _ -> Semigroup.stimesMonoid n 676 | #endif 677 | -------------------------------------------------------------------------------- /Data/DList/Unsafe.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | -- Options passed to Haddock 3 | {-# OPTIONS_HADDOCK hide #-} 4 | 5 | ----------------------------------------------------------------------------- 6 | 7 | {-# LANGUAGE CPP #-} 8 | 9 | -- CPP: GHC >= 7.8 for Safe Haskell 10 | #if __GLASGOW_HASKELL__ >= 708 11 | {- 12 | 13 | The 'Data.DList.Unsafe' module exports 'UnsafeDList' and 'unsafeApplyDList', 14 | which allow breaking the invariant of the 'DList' newtype. Therefore, we 15 | explicitly mark 'Data.DList.Unsafe' as unsafe. 16 | 17 | -} 18 | {-# LANGUAGE Unsafe #-} 19 | #endif 20 | 21 | ----------------------------------------------------------------------------- 22 | 23 | {-| 24 | 25 | Module: Data.DList.Unsafe 26 | Copyright: © 2006-2009 Don Stewart, 2013-2020 Sean Leather 27 | License: BSD-3-Clause 28 | 29 | Maintainer: sean.leather@gmail.com 30 | Stability: stable 31 | 32 | This module exports the 'DList' constructor, 'UnsafeDList', and the record label, 33 | 'unsafeApplyDList', both of which can be used to create unsafe 'DList' values 34 | that break the invariant preserved by the names exported from 'Data.DList'. 35 | 36 | -} 37 | {- ORMOLU_ENABLE -} 38 | 39 | module Data.DList.Unsafe (DList (UnsafeDList, unsafeApplyDList)) where 40 | 41 | import Data.DList.Internal 42 | -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain -------------------------------------------------------------------------------- /bench/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Criterion.Main (bench, bgroup, defaultMain, whnf) 4 | import qualified Data.DList as DList 5 | import qualified Data.DList.DNonEmpty as DNonEmpty 6 | import qualified Data.DList.NonEmpty as NonEmptyDList 7 | import qualified Data.Foldable as Foldable 8 | import qualified Data.List.NonEmpty as NonEmpty 9 | import Prelude 10 | 11 | main :: IO () 12 | main = 13 | defaultMain 14 | [ bgroup 15 | "append" 16 | [ bench "List" $ 17 | whnf (append 1000) $ 18 | [1, 2, 3, 4, 5], 19 | bench "DList" $ 20 | whnf (append 1000) $ 21 | DList.fromList [1, 2, 3, 4, 5], 22 | bench "NonEmpty" $ 23 | whnf (append 1000) $ 24 | 1 NonEmpty.:| [2, 3, 4, 5], 25 | bench "DNonEmpty" $ 26 | whnf (append 1000) $ 27 | DNonEmpty.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5], 28 | bench "NonEmptyDList" $ 29 | whnf (append 1000) $ 30 | NonEmptyDList.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5] 31 | ], 32 | bgroup 33 | "fmap_append" 34 | [ bench "List" $ 35 | whnf (fmap_append 1000) $ 36 | [1, 2, 3, 4, 5], 37 | bench "DList" $ 38 | whnf (fmap_append 1000) $ 39 | DList.fromList [1, 2, 3, 4, 5], 40 | bench "NonEmpty" $ 41 | whnf (fmap_append 1000) $ 42 | 1 NonEmpty.:| [2, 3, 4, 5], 43 | bench "DNonEmpty" $ 44 | whnf (fmap_append 1000) $ 45 | DNonEmpty.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5], 46 | bench "NonEmptyDList" $ 47 | whnf (fmap_append 1000) $ 48 | NonEmptyDList.fromNonEmpty $ 1 NonEmpty.:| [2, 3, 4, 5] 49 | ], 50 | bgroup 51 | "Tree" 52 | [ bench "flattenSlow" $ 53 | whnf flattenSlow exampleTree, 54 | bench "flattenFast" $ 55 | whnf flattenFast exampleTree 56 | ] 57 | ] 58 | 59 | -- | Left-nested append 60 | append :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int 61 | append m right = Foldable.foldl' (+) 0 $ Foldable.toList $ go m right 62 | where 63 | go n left 64 | | n <= 0 = left 65 | | otherwise = go (pred n) (left <> right) 66 | 67 | -- | Left-nested append with map 68 | fmap_append :: (Foldable f, Functor f, Semigroup (f Int)) => Int -> f Int -> Int 69 | fmap_append m x = Foldable.foldl' (+) 0 $ Foldable.toList $ go m x 70 | where 71 | go n y 72 | | n <= 0 = y 73 | | otherwise = go (pred n) (fmap (+ 1) $ y <> x) 74 | 75 | data Tree a = Leaf a | Branch (Tree a) (Tree a) 76 | 77 | exampleTree :: Tree Char 78 | exampleTree = 79 | Branch 80 | (Branch 81 | (Branch 82 | (Branch (Leaf 'a') (Leaf 'b')) 83 | (Leaf 'c')) 84 | (Leaf 'd')) 85 | (Branch (Leaf 'e') (Leaf 'f')) 86 | 87 | flattenSlow :: Tree a -> [a] 88 | flattenSlow = go 89 | where 90 | go (Leaf x) = [x] 91 | go (Branch left right) = go left ++ go right 92 | 93 | flattenFast :: Tree a -> [a] 94 | flattenFast = DList.toList . go 95 | where 96 | go (Leaf x) = DList.singleton x 97 | go (Branch left right) = go left `DList.append` go right 98 | -------------------------------------------------------------------------------- /bench/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /bench/dlist-bench.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.10 2 | 3 | name: dlist-bench 4 | version: 0.1.0.0 5 | license: BSD3 6 | license-file: ../license.md 7 | author: Oleg Grenrus, Sean Leather 8 | maintainer: Sean Leather 9 | copyright: 2017-2020 Oleg Grenrus, 2020 Sean Leather 10 | extra-source-files: readme.md 11 | build-type: Simple 12 | 13 | executable dlist-bench 14 | hs-source-dirs: . .. 15 | main-is: Main.hs 16 | other-modules: Data.DList 17 | Data.DList.Internal 18 | Data.DList.DNonEmpty 19 | Data.DList.DNonEmpty.Internal 20 | build-depends: base >= 4 && < 5, 21 | criterion >= 1.5 && < 1.6, 22 | deepseq >= 1.1 && < 1.5, 23 | dlist-nonempty >= 0.1 && < 0.2 24 | default-language: Haskell2010 25 | ghc-options: -Wall 26 | -------------------------------------------------------------------------------- /bench/readme.md: -------------------------------------------------------------------------------- 1 | This directory contains a benchmark package for the `dlist` package. It is a 2 | separate package instead of a benchmark suite in the [`dlist.cabal`][] to avoid 3 | a cyclical dependency by `aeson` on `dlist`. 4 | 5 | To run the benchmarks: 6 | 7 | ```sh 8 | cabal run 9 | ``` 10 | 11 | [`dlist.cabal`]: ../dlist.cabal 12 | -------------------------------------------------------------------------------- /changelog.md: -------------------------------------------------------------------------------- 1 | # Change Log 2 | 3 | ## [Unreleased][] 4 | 5 | _No unreleased changes at this time._ 6 | 7 | ## [v1.0][] 8 | 9 | Released on **2020-07-18**, **Nelson Mandela International Day**. 10 | 11 | ### Added 12 | 13 | * `intercalate` for `DList` ([#43][], [Jacob Leach][]) 14 | * `Traversable` instance for `DList` ([#45][], [Veronika Romashkina][]) 15 | * `Data.DList.Internal` for the `DList` implementation, `Data.DList.Unsafe` for 16 | exporting the `DList` constructor `UnsafeDList` and record label 17 | `unsafeApplyDList` ([#55][], [#59][]) 18 | * `Data.DList.DNonEmpty` ([#60][]) 19 | * GitHub Action for uploading a release ([#74][]) 20 | * `dlist-bench`, a benchmark package ([#71][]) 21 | 22 | ### Changed 23 | 24 | * `stimes` for `DList` defined with `stimesMonoid` ([#46][], [Janek Spaderna][]) 25 | * Type of `tail`: `DList a -> DList a` to `DList a -> [a]` ([#69][]) 26 | * GitHub Action for continuous integration testing to replace Travis-CI 27 | ([#47][], [#50][]) 28 | * GHC warning and error improvements ([#72][], [#73][]) 29 | * Improved documentation ([#55][], [#70][], [#76][], [#77][]) 30 | 31 | ### Removed 32 | 33 | * `list :: b -> (a -> DList a -> b) -> DList a -> b` ([#69][]) 34 | 35 | ## [v0.8.0.8][] 36 | 37 | Released on **2020-04-02**, **World Autism Awareness Day**. 38 | 39 | ### Added 40 | 41 | * `toList` in the `Foldable` instance for `DList` ([#36][], [Ryan Scott][]) 42 | 43 | ### Changed 44 | 45 | * `QuickCheck` upper bound: 2.14 to 2.15 ([`a7ea60d`][]) 46 | 47 | ### Fixed 48 | 49 | * Documented time complexity of `head` for `DList` ([#35][], [Simon Jakobi][]) 50 | 51 | ## [v0.8.0.7][] 52 | 53 | Released on **2019-08-05**, **Independence Day in Burkina Faso**. 54 | 55 | ### Added 56 | 57 | * `MonadFail` instance for `DList` ([#32][], [Vanessa McHale][]) 58 | 59 | ### Changed 60 | 61 | * `deepseq` upper bound: 2 to 1.5 ([#33][], [Herbert Valerio Riedel][]) 62 | 63 | ## [v0.8.0.6][] 64 | 65 | Released on **2019-03-29**, **Martyrs' Day in Madagascar**. 66 | 67 | ### Changed 68 | 69 | * `QuickCheck` upper bound: 2.13 to 2.14 ([`242511c`][]) 70 | 71 | ## [v0.8.0.5][] 72 | 73 | Released on **2018-09-13**, **Day of the Programmer**. 74 | 75 | ### Changed 76 | 77 | * `QuickCheck` upper bound: 2.12 to 2.13 ([`0e2b3a5`][]) 78 | 79 | ## [v0.8.0.4][] 80 | 81 | Released on **2018-01-19**, **Kokborok Day**. 82 | 83 | ### Added 84 | 85 | * `{-# LANGUAGE Trustworthy #-}` in `Data.DList` ([#31][], [Bertram 86 | Felgenhauer][]) 87 | 88 | ### Changed 89 | 90 | * `QuickCheck` upper bound: 2.11 to 2.12 ([`3d9c8ad`][]) 91 | * `QuickCheck` lower bound: 2.7/2.9 to 2.10 ([`4f92012`][]) 92 | * `Arbitrary`, `Arbitrary1` instances for `NonEmpty` in the test suite copied 93 | from `quickcheck-instances` ([`4f92012`][]) 94 | 95 | ## [v0.8.0.3][] 96 | 97 | Released on **2017-07-04**, **Independence Day in the United States**. 98 | 99 | ### Added 100 | 101 | * `quickcheck-instances` dependency in the test suite for the `Arbitrary`, 102 | `Arbitrary1` instances for `NonEmpty` ([`5b41d0d`][]) 103 | 104 | ### Changed 105 | 106 | * `QuickCheck` upper bound: 2.10 to 2.11 ([`b2f791a`][]) 107 | 108 | ### Fixed 109 | 110 | * `stimes` property in the test suite ([#30][], [Oleg Grenrus][]) 111 | 112 | ## [v0.8.0.2][] 113 | 114 | Released on **2016-09-04**, **World Sexual Health Day**. 115 | 116 | ### Fixed 117 | 118 | * Missing module `OverloadedStrings` in the test suite ([#29][], [Sergei 119 | Trofimovich][]) 120 | 121 | ## [v0.8.0.1][] 122 | 123 | Released on **2016-07-29**, the **58th Anniversary of the Creation of NASA**. 124 | 125 | ### Changed 126 | 127 | * `QuickCheck` lower bound: 2.7 to 2.9 for GHC >= 8 ([#28][], [Adam Bergmark][]) 128 | 129 | ## [v0.8][] 130 | 131 | Released on **2016-07-17**, **Constitution Day in South Korea**. 132 | 133 | ### Added 134 | 135 | * Pattern synonyms `Nil` and `Cons` ([#15][]) 136 | * `Semigroup` instance for `DList` ([#25][]) 137 | * Canonical `Applicative` and `Monad` instances for `DList` ([#23][], [Herbert 138 | Valerio Riedel][]) 139 | 140 | ### Changed 141 | 142 | * `IsString` instance for `DList` is no longer flexible ([#26][], [Baldur 143 | Blöndal][]) 144 | * `QuickCheck` upper bound: 2.9 to 2.10 ([`ef7eac5`][]) 145 | 146 | ## [v0.7.1.2][] 147 | 148 | Released on **2015-08-23**, **International Day for the Remembrance of the Slave 149 | Trade and its Abolition**. 150 | 151 | ### Fixed 152 | 153 | * Imports causing warnings in GHC 7.10 ([#22][], [Mikhail Glushenkov][]) 154 | 155 | ## [v0.7.1.1][] 156 | 157 | Released on **2015-03-19**, **St. Joseph's Day**. 158 | 159 | ### Changed 160 | 161 | * `QuickCheck` lower bound: 2.5 to 2.7 ([`2d8ec37`][]) 162 | * `QuickCheck` upper bound: 2.8 to 2.9 ([`3176153`][]) 163 | 164 | ## [v0.7.1][] 165 | 166 | Released on **2014-06-28**, the **100th Anniversary of the Assassination of 167 | Franz Ferdinand**. 168 | 169 | ### Added 170 | 171 | * `IsList` instance for `DList` ([#13][], [Baldur Blöndal][]) 172 | 173 | ## [v0.7.0.1][] 174 | 175 | Released on **2014-03-24**, **World Tuberculosis Day**. 176 | 177 | ### Changed 178 | 179 | * `QuickCheck` upper bound: 2.7 to 2.8 ([`7494dbc`][]) 180 | 181 | ## [v0.7][] 182 | 183 | Released on **2014-03-17**, **St. Patrick's Day**. 184 | 185 | ### Added 186 | 187 | * `NFData` instance for `DList` ([#10][], [Evan Laforge][]) 188 | * `IsString` instance for `DList` ([`771a38d`][]) 189 | 190 | ### Changed 191 | 192 | * `base` lower bound: 2 to 4 ([`77f6898`][]) 193 | 194 | ### Removed 195 | 196 | * `DList` constructor and record label, `maybeReturn` ([`62c0c09`][]) 197 | 198 | ## [v0.6.0.1][] 199 | 200 | Released on **2013-12-01**, **World AIDS Day**. 201 | 202 | ### Changed 203 | 204 | * `QuickCheck` lower bound: 2.6 to 2.5 ([#9][], [Michael Snoyman][]) 205 | 206 | ## [v0.6][] 207 | 208 | Released on **2013-11-29**, **Black Friday**. 209 | 210 | ### Added 211 | 212 | * `apply` to replace `DList` record label `unDL` ([#4][]) 213 | * `Eq`, `Ord`, `Show`, and `Alternative` instances for `DList` ([#1][], [Bas van 214 | Dijk][]) 215 | * `Read` instance for `DList` ([`58ef305`][]) 216 | * `Foldable` instance for `DList` ([`5b1d09f`][]) 217 | * Travis-CI for continuous integration testing ([#6][], [Herbert Valerio 218 | Riedel][]) 219 | 220 | ### Changed 221 | 222 | * Maintenance: [Don Stewart][] to [Sean Leather][] ([#2][], [Bas van Dijk][]) 223 | * Repository: `http://code.haskell.org/~dons/code/dlist/` to 224 | `https://github.com/spl/dlist` 225 | * `base` lower bound: 0 to 2 ([`6e1d9e7`][]) 226 | 227 | ### Fixed 228 | 229 | * Test suite simplified and changed to use `cabal test` ([`9f58759`][]) 230 | 231 | ### Deprecated 232 | 233 | * Exported `DList` constructor and record label, `maybeReturn` ([#4][]) 234 | 235 | 236 | 237 | 238 | 239 | [v0.6]: https://github.com/spl/dlist/compare/v0.5...v0.6 240 | [v0.6.0.1]: https://github.com/spl/dlist/compare/v0.6...v0.6.0.1 241 | [v0.7]: https://github.com/spl/dlist/compare/v0.6.0.1...v0.7 242 | [v0.7.0.1]: https://github.com/spl/dlist/compare/v0.7...v0.7.0.1 243 | [v0.7.1.1]: https://github.com/spl/dlist/compare/v0.7.1...v0.7.1.1 244 | [v0.7.1.2]: https://github.com/spl/dlist/compare/v0.7.1.1...v0.7.1.2 245 | [v0.7.1]: https://github.com/spl/dlist/compare/v0.7.0.1...v0.7.1 246 | [v0.8]: https://github.com/spl/dlist/compare/v0.7.1.2...v0.8 247 | [v0.8.0.1]: https://github.com/spl/dlist/compare/v0.8...v0.8.0.1 248 | [v0.8.0.2]: https://github.com/spl/dlist/compare/v0.8.0.1...v0.8.0.2 249 | [v0.8.0.3]: https://github.com/spl/dlist/compare/v0.8.0.2...v0.8.0.3 250 | [v0.8.0.4]: https://github.com/spl/dlist/compare/v0.8.0.3...v0.8.0.4 251 | [v0.8.0.5]: https://github.com/spl/dlist/compare/v0.8.0.4...v0.8.0.5 252 | [v0.8.0.6]: https://github.com/spl/dlist/compare/v0.8.0.5...v0.8.0.6 253 | [v0.8.0.7]: https://github.com/spl/dlist/compare/v0.8.0.6...v0.8.0.7 254 | [v0.8.0.8]: https://github.com/spl/dlist/compare/v0.8.0.7...v0.8.0.8 255 | [v1.0]: https://github.com/spl/dlist/compare/v0.8.0.8...v1.0 256 | 257 | 258 | 259 | [Unreleased]: https://github.com/spl/dlist/compare/v1.0...HEAD 260 | 261 | 262 | 263 | [#1]: https://github.com/spl/dlist/pull/1 264 | [#2]: https://github.com/spl/dlist/pull/2 265 | [#4]: https://github.com/spl/dlist/issues/4 266 | [#6]: https://github.com/spl/dlist/pull/6 267 | [#9]: https://github.com/spl/dlist/pull/9 268 | [#10]: https://github.com/spl/dlist/issues/10 269 | [#13]: https://github.com/spl/dlist/pull/13 270 | [#15]: https://github.com/spl/dlist/issues/15 271 | [#22]: https://github.com/spl/dlist/pull/22 272 | [#23]: https://github.com/spl/dlist/pull/23 273 | [#25]: https://github.com/spl/dlist/issues/25 274 | [#26]: https://github.com/spl/dlist/pull/26 275 | [#28]: https://github.com/spl/dlist/issues/28 276 | [#29]: https://github.com/spl/dlist/pull/29 277 | [#30]: https://github.com/spl/dlist/pull/30 278 | [#31]: https://github.com/spl/dlist/pull/31 279 | [#32]: https://github.com/spl/dlist/pull/32 280 | [#33]: https://github.com/spl/dlist/pull/33 281 | [#35]: https://github.com/spl/dlist/pull/35 282 | [#36]: https://github.com/spl/dlist/pull/36 283 | [#43]: https://github.com/spl/dlist/pull/43 284 | [#45]: https://github.com/spl/dlist/pull/45 285 | [#46]: https://github.com/spl/dlist/pull/46 286 | [#47]: https://github.com/spl/dlist/pull/47 287 | [#50]: https://github.com/spl/dlist/pull/50 288 | [#55]: https://github.com/spl/dlist/pull/55 289 | [#59]: https://github.com/spl/dlist/pull/59 290 | [#60]: https://github.com/spl/dlist/pull/60 291 | [#69]: https://github.com/spl/dlist/pull/69 292 | [#70]: https://github.com/spl/dlist/pull/70 293 | [#71]: https://github.com/spl/dlist/pull/71 294 | [#72]: https://github.com/spl/dlist/pull/72 295 | [#73]: https://github.com/spl/dlist/pull/73 296 | [#74]: https://github.com/spl/dlist/pull/74 297 | [#76]: https://github.com/spl/dlist/pull/76 298 | [#77]: https://github.com/spl/dlist/pull/77 299 | 300 | 301 | 302 | [`0e2b3a5`]: https://github.com/spl/dlist/commit/0e2b3a542796b50796f2aa6dde4665911b9d15a1 303 | [`242511c`]: https://github.com/spl/dlist/commit/242511c501299b38c57efeafb9e604f29cb8bb7a 304 | [`2d8ec37`]: https://github.com/spl/dlist/commit/2d8ec370a3c19d39c0d543f39f8fc31948087fd9 305 | [`3176153`]: https://github.com/spl/dlist/commit/3176153187b130002a1577675cdcd5509dd86556 306 | [`3d9c8ad`]: https://github.com/spl/dlist/commit/3d9c8ad348b419590a121b8a1604e8ebd01bffbe 307 | [`4f92012`]: https://github.com/spl/dlist/commit/4f920128592f6f99b8c57a1adf50cdb16d26c13b 308 | [`58ef305`]: https://github.com/spl/dlist/commit/58ef305146474d77a49a3f9e0148393eb6546fd2 309 | [`5b1d09f`]: https://github.com/spl/dlist/commit/5b1d09f6daad5543d927a003b4ea5ca50f3e6604 310 | [`5b41d0d`]: https://github.com/spl/dlist/commit/5b41d0d84a0a14c75798ca30883b613b37ad464a 311 | [`62c0c09`]: https://github.com/spl/dlist/commit/62c0c099d20c3f950d7950dc9ec5a6b3797acaf8 312 | [`6e1d9e7`]: https://github.com/spl/dlist/commit/6e1d9e74e0a7c7f9c6612cd6bd0b4753f5651968 313 | [`7494dbc`]: https://github.com/spl/dlist/commit/7494dbc56550a0f7eb09304403a61c68b4a360e3 314 | [`771a38d`]: https://github.com/spl/dlist/commit/771a38df953b97a631806884133a76ab8dfcfce8 315 | [`77f6898`]: https://github.com/spl/dlist/commit/77f689829223b5fd6762e24594ce9111e6ef8f6b 316 | [`9f58759`]: https://github.com/spl/dlist/commit/9f587599f128a4dc147c5c8f907b29b46110763b 317 | [`a7ea60d`]: https://github.com/spl/dlist/commit/a7ea60d3d02775216a15d6f688db230d7735c9d1 318 | [`b2f791a`]: https://github.com/spl/dlist/commit/b2f791ab98e2091303fff4567727716b6021b63e 319 | [`ef7eac5`]: https://github.com/spl/dlist/commit/ef7eac55fc7e180ac3441657f4971ed171b0669c 320 | 321 | 322 | 323 | [Adam Bergmark]: https://github.com/bergmark 324 | [Baldur Blöndal]: https://github.com/Icelandjack 325 | [Bas van Dijk]: https://github.com/basvandijk 326 | [Bertram Felgenhauer]: https://github.com/int-e 327 | [Don Stewart]: https://github.com/donsbot 328 | [Evan Laforge]: https://github.com/elaforge 329 | [Herbert Valerio Riedel]: https://github.com/hvr 330 | [Jacob Leach]: https://github.com/riz0id 331 | [Janek Spaderna]: https://github.com/JaSpa 332 | [Michael Snoyman]: https://github.com/snoyberg 333 | [Mikhail Glushenkov]: https://github.com/23Skidoo 334 | [Oleg Grenrus]: https://github.com/phadej 335 | [Ryan Scott]: https://github.com/RyanGlScott 336 | [Sean Leather]: https://github.com/spl 337 | [Sergei Trofimovich]: https://github.com/trofi 338 | [Simon Jakobi]: https://github.com/sjakobi 339 | [Vanessa McHale]: https://github.com/vmchale 340 | [Veronika Romashkina]: https://github.com/vrom911 341 | -------------------------------------------------------------------------------- /dlist.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.10 2 | 3 | name: dlist 4 | version: 1.0 5 | synopsis: Difference lists 6 | description: 7 | List-like types supporting O(1) append and snoc operations. 8 | category: Data 9 | license: BSD3 10 | license-file: license.md 11 | author: Don Stewart 12 | maintainer: Sean Leather 13 | copyright: 2006-2009 Don Stewart, 2013-2020 Sean Leather, 2017-2020 Oleg Grenrus, contributors 14 | homepage: https://github.com/spl/dlist 15 | bug-reports: https://github.com/spl/dlist/issues 16 | extra-source-files: readme.md, 17 | changelog.md 18 | tests/ImportUnsafe.hs 19 | build-type: Simple 20 | tested-with: GHC==7.0.4 21 | GHC==7.2.2 22 | GHC==7.4.2 23 | GHC==7.6.3 24 | GHC==7.8.4 25 | GHC==7.10.3 26 | GHC==8.0.2 27 | GHC==8.2.2 28 | GHC==8.4.4 29 | GHC==8.6.5 30 | GHC==8.8.4 31 | GHC==8.10.7 32 | GHC==9.0.2 33 | GHC==9.2.8 34 | GHC==9.4.8 35 | GHC==9.6.4 36 | GHC==9.8.1 37 | 38 | source-repository head 39 | type: git 40 | location: https://github.com/spl/dlist.git 41 | 42 | flag Werror 43 | description: Enable -Werror 44 | default: False 45 | manual: True 46 | 47 | library 48 | build-depends: 49 | base >= 4 && < 5, 50 | deepseq >= 1.1 && < 1.6 51 | exposed-modules: Data.DList 52 | Data.DList.Unsafe 53 | other-modules: Data.DList.Internal 54 | if impl(ghc >= 8.0) 55 | exposed-modules: Data.DList.DNonEmpty 56 | other-modules: Data.DList.DNonEmpty.Internal 57 | default-language: Haskell2010 58 | default-extensions: TypeOperators 59 | ghc-options: -Wall 60 | if impl(ghc >= 8.0) 61 | ghc-options: -Wcompat 62 | -Wincomplete-record-updates 63 | -Wincomplete-uni-patterns 64 | -Wnoncanonical-monad-instances 65 | if impl(ghc >= 8.2) 66 | ghc-options: -Wmissing-home-modules 67 | if impl(ghc >= 8.4) 68 | ghc-options: -Wpartial-fields 69 | if impl(ghc >= 8.10) 70 | ghc-options: -Wmissing-safe-haskell-mode 71 | -Wtrustworthy-safe 72 | if flag(Werror) 73 | ghc-options: -Werror 74 | 75 | test-suite test 76 | type: exitcode-stdio-1.0 77 | main-is: Main.hs 78 | other-modules: DListProperties 79 | OverloadedStrings 80 | QuickCheckUtil 81 | if impl(ghc >= 8.0) 82 | other-modules: DNonEmptyProperties 83 | hs-source-dirs: tests 84 | build-depends: dlist, 85 | base, 86 | -- QuickCheck-2.10 is the first version supporting 87 | -- base-4.9 (ghc-8) without the Arbitrary NonEmpty 88 | -- instance, which we include ourselves. 89 | QuickCheck >= 2.10 && < 2.15 90 | default-language: Haskell2010 91 | ghc-options: -Wall 92 | if impl(ghc >= 8.0) 93 | ghc-options: -Wcompat 94 | -Wincomplete-record-updates 95 | -Wincomplete-uni-patterns 96 | -Wnoncanonical-monad-instances 97 | if impl(ghc >= 8.2) 98 | ghc-options: -Wmissing-home-modules 99 | if impl(ghc >= 8.4) 100 | ghc-options: -Wpartial-fields 101 | if impl(ghc >= 8.10) 102 | ghc-options: -Wmissing-safe-haskell-mode 103 | -Wtrustworthy-safe 104 | if flag(Werror) 105 | ghc-options: -Werror 106 | -------------------------------------------------------------------------------- /doc/release.md: -------------------------------------------------------------------------------- 1 | # Release Instructions 2 | 3 | These are the steps for making a new release of the `dlist` package. 4 | 5 | 1. Check out the latest `main` branch and make sure it is up to date. 6 | 7 | ```sh 8 | cd 9 | git checkout main 10 | git pull 11 | ``` 12 | 13 | 2. Create a new branch for the final changes needed before the release. 14 | 15 | ```sh 16 | git checkout -b version 17 | ``` 18 | 19 | 3. Update the [`changelog.md`][] and [`dlist.cabal`][] for the new version, 20 | `$VERSION`. 21 | 22 | ```sh 23 | VERSION= 24 | $EDITOR changelog.md 25 | $EDITOR dlist.cabal 26 | git commit -am "Bump version to $VERSION" 27 | ``` 28 | 29 | 4. Push the branch and create a pull request on GitHub. 30 | 31 | ```sh 32 | git push -u origin 33 | ``` 34 | 35 | 5. Check for problems on the pull request. 36 | 37 | 1. Check the [new `changelog.md`][] and [new `dlist.cabal`][]. 38 | 39 | If there's a problem, return to step 3. 40 | 41 | 2. Check for tests passing. 42 | 43 | If there's a problem, revisit in another branch and pull request. Then, 44 | merge `main` in to `version` and continue with the next step. 45 | 46 | 6. Squash and merge the pull request on GitHub. 47 | 48 | 7. Tag the new version on the `main` branch. 49 | 50 | ```sh 51 | git checkout main 52 | git pull 53 | git branch -D version 54 | git tag v$VERSION 55 | git push --tags 56 | ``` 57 | 58 | 8. Publish the [tag][tags] as a release. 59 | 60 | This will initiate the `upload` workflow, which will run `cabal upload` to 61 | upload the new version to Hackage. 62 | 63 | 9. Check [Hackage][] for the candidate documentation and build log. 64 | 65 | If there's a problem, revisit in another branch and pull request. Then, 66 | return to step 1 with a new `$VERSION`. 67 | 68 | 10. Publish the candidate on Hackage. 69 | 70 | [Hackage]: https://hackage.haskell.org/package/dlist 71 | [`changelog.md`]: ./changelog.md 72 | [`dlist.cabal`]: ./dlist.cabal 73 | [new `changelog.md`]: https://github.com/spl/dlist/blob/version/changelog.md 74 | [new `dlist.cabal`]: https://github.com/spl/dlist/blob/version/dlist.cabal 75 | [tags]: https://github.com/spl/dlist/tags 76 | -------------------------------------------------------------------------------- /license.md: -------------------------------------------------------------------------------- 1 | Copyright © 2006-2009 Don Stewart, 2013-2020 Sean Leather, contributors 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without modification, 6 | are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | 3. Neither the name of the copyright holders nor the names of other contributors 16 | may be used to endorse or promote products derived from this software without 17 | specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND 20 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 21 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR 27 | TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 28 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | # Difference Lists 2 | 3 | [![test-badge][]][test] 4 | [![hackage-badge][]][hackage-dlist] 5 | [![packdeps-badge][]][packdeps] 6 | 7 | _**List-like types supporting O(1) `append` and `snoc` operations.**_ 8 | 9 | ## Installation 10 | 11 | [`dlist`][hackage-dlist] is a Haskell package available from [Hackage][hackage]. 12 | It can be installed with [`cabal`][cabal] or [`stack`][stack]. 13 | 14 | See the [change log][changelog] for the changes in each version. 15 | 16 | ## Usage 17 | 18 | Here is an example of “flattening” a `Tree` into a list of the elements in its 19 | `Leaf` constructors: 20 | 21 | ```haskell 22 | import qualified Data.DList as DList 23 | 24 | data Tree a = Leaf a | Branch (Tree a) (Tree a) 25 | 26 | flattenSlow :: Tree a -> [a] 27 | flattenSlow = go 28 | where 29 | go (Leaf x) = [x] 30 | go (Branch left right) = go left ++ go right 31 | 32 | flattenFast :: Tree a -> [a] 33 | flattenFast = DList.toList . go 34 | where 35 | go (Leaf x) = DList.singleton x 36 | go (Branch left right) = go left `DList.append` go right 37 | ``` 38 | 39 | (The above code can be found in the [benchmark][].) 40 | 41 | `flattenSlow` is likely to be slower than `flattenFast`: 42 | 43 | 1. `flattenSlow` uses `++` to concatenate lists, each of which is recursively 44 | constructed from the `left` and `right` `Tree` values in the `Branch` 45 | constructor. 46 | 47 | 2. `flattenFast` does not use `++` but constructs a composition of functions, 48 | each of which is a “cons” introduced by `DList.singleton` (`(x :)`). The 49 | function `DList.toList` applies the composed function to `[]`, constructing 50 | a list in the end. 51 | 52 | To see the difference between `flattenSlow` and `flattenFast`, consider some 53 | rough evaluations of the functions applied to a `Tree`: 54 | 55 | ```haskell 56 | flattenSlow (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) 57 | = go (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) 58 | = go (Branch (Leaf 'a') (Leaf 'b')) ++ go (Leaf 'c') 59 | = (go (Leaf 'a') ++ go (Leaf 'b')) ++ "c" 60 | = ("a" ++ "b") ++ "c" 61 | = ('a' : [] ++ "b") ++ "c" 62 | = ('a' : "b") ++ "c" 63 | = 'a' : "b" ++ "c" 64 | = 'a' : 'b' : [] ++ "c" 65 | = 'a' : 'b' : "c" 66 | ``` 67 | 68 | ```haskell 69 | flattenFast (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) 70 | = toList $ go (Branch (Branch (Leaf 'a') (Leaf 'b')) (Leaf 'c')) 71 | = toList $ go (Branch (Leaf 'a') (Leaf 'b')) `append` go (Leaf 'c') 72 | = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) . unsafeApplyDList (go (Leaf 'c')) $ [] 73 | = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (go (Leaf 'c')) []) 74 | = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (singleton 'c') []) 75 | = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) (unsafeApplyDList (UnsafeDList ((:) 'c')) []) 76 | = unsafeApplyDList (go (Branch (Leaf 'a') (Leaf 'b'))) "c" 77 | = unsafeApplyDList (UnsafeDList (unsafeApplyDList (go (Leaf 'a')) . unsafeApplyDList (go (Leaf 'b')))) "c" 78 | = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (go (Leaf 'b')) "c") 79 | = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (singleton 'b') "c") 80 | = unsafeApplyDList (go (Leaf 'a')) (unsafeApplyDList (UnsafeDList ((:) 'b')) "c") 81 | = unsafeApplyDList (go (Leaf 'a')) ('b' : "c") 82 | = unsafeApplyDList (singleton 'a') ('b' : "c") 83 | = unsafeApplyDList (UnsafeDList ((:) 'a')) ('b' : "c") 84 | = 'a' : 'b' : "c" 85 | ``` 86 | 87 | The left-nested `++` in `flattenSlow` results in intermediate list constructions 88 | that are immediately discarded in the evaluation of the outermost `++`. On the 89 | other hand, the evaluation of `flattenFast` involves no intermediate list 90 | construction but rather function applications and `newtype` constructor wrapping 91 | and unwrapping. This is where the efficiency comes from. 92 | 93 | _**Warning!**_ Note that there is truth in the above, but there is also a lot of 94 | hand-waving and intrinsic complexity. For example, there may be GHC rewrite 95 | rules that apply to `++`, which will change the actual evaluation. And, of 96 | course, strictness, laziness, and sharing all play a significant role. Also, not 97 | every function in the `dlist` package is the most efficient for every situation. 98 | 99 | _**Moral of the story:**_ If you are using `dlist` to speed up your code, check 100 | to be sure that it actually does. Benchmark! 101 | 102 | ## Design Notes 103 | 104 | These are some notes on design and development choices made for the `dlist` 105 | package. 106 | 107 | ### Avoid `++` 108 | 109 | The original intent of Hughes' representation of lists as first-class functions 110 | was to provide an abstraction such that the list `append` operation found in 111 | functional programming languages (and now called `++` in Haskell) would not 112 | appear in left-nested positions to avoid duplicated structure as lists are 113 | constructed. The lesson learned by many people using list over the years is that 114 | the `append` operation can appear, sometimes surprisingly, in places they don't 115 | expect it. 116 | 117 | One of our goals is for the `dlist` package to avoid surprising its users with 118 | unexpected insertions of `++`. Towards this end, there should be a minimal set 119 | of functions in `dlist` in which `++` can be directly or indirectly found. The 120 | list of known uses of `++` includes: 121 | 122 | * `DList`: `fromList`, `fromString`, `read` 123 | * `DNonEmpty`: `fromList`, `fromNonEmpty`, `fromString`, `read` 124 | 125 | If any future requested functions involve `++` (e.g. via `fromList`), the burden 126 | of inclusion is higher than it would be otherwise. 127 | 128 | ### Abstraction 129 | 130 | The `DList` representation and its supporting functions (e.g. `append`, `snoc`, 131 | etc.) rely on an invariant to preserve its safe use. That is, without this 132 | invariant, a user may encounter unexpected outcomes. 133 | 134 | (We use safety in the sense that the semantics are well-defined and expected, 135 | not in the sense of side of referential transparency. The invariant does not 136 | directly lead to side effects in the `dlist` package, but a program that uses an 137 | unsafely generated `DList` may do something surprising.) 138 | 139 | The invariant is that, for any `xs :: DList a`: 140 | 141 | ```haskell 142 | fromList (toList xs) = xs 143 | ``` 144 | 145 | To see how this invariant can be broken, consider this example: 146 | 147 | ```haskell 148 | xs :: DList a 149 | xs = UnsafeDList (const []) 150 | 151 | fromList (toList (xs `snoc` 1)) 152 | = fromList (toList (UnsafeDList (const []) `snoc` 1)) 153 | = fromList (toList (UnsafeDList (unsafeApplyDList (UnsafeDList (const [])) . (x :)))) 154 | = fromList (toList (UnsafeDList (const [] . (x :)))) 155 | = fromList (($ []) . unsafeApplyDList $ UnsafeDList (const [] . (x :))) 156 | = fromList (const [] . (x :) $ []) 157 | = fromList (const [] [x]) 158 | = fromList [] 159 | = UnsafeDList (++ []) 160 | ``` 161 | 162 | The invariant can also be stated as: 163 | 164 | ```haskell 165 | toList (fromList (toList xs)) = toList xs 166 | ``` 167 | 168 | And we can restate the example as: 169 | 170 | ```haskell 171 | toList (fromList (toList (xs `snoc` 1))) 172 | = toList (UnsafeDList (++ [])) 173 | = [] 174 | ``` 175 | 176 | It would be rather unhelpful and surprising to find ``(xs `snoc` 1)`` turned out 177 | to be the empty list. 178 | 179 | To preserve the invariant on `DList`, we provide it as an abstract type in the 180 | `Data.DList` module. The constructor, `UnsafeDList`, and record label, 181 | `unsafeApplyDList`, are not exported because these can be used, as shown above, 182 | to break the invariant. 183 | 184 | All of that said, there have been numerous requests to export the `DList` 185 | constructor. We are not convinced that it is necessary, but we are convinced 186 | that users should decide for themselves. 187 | 188 | To use the constructor and record label of `DList`, you import them as follows: 189 | 190 | ```haskell 191 | import Data.DList.Unsafe (DList(UnsafeDList, unsafeApplyDList)) 192 | ``` 193 | 194 | If you are using Safe Haskell, you may need to add this at the top of your 195 | module: 196 | 197 | ```haskell 198 | {-# LANGUAGE Trustworthy #-} 199 | ``` 200 | 201 | Just be aware that the burden of proof for safety is on you. 202 | 203 | ## References 204 | 205 | These are various references where you can learn more about difference lists. 206 | 207 | ### Research 208 | 209 | * **A novel representation of lists and its application to the function 210 | “reverse.”** John Hughes. Information Processing Letters. Volume 22, Issue 3. 211 | 1986-03. Pages 141-144. [PDF][hughes-pdf] 212 | 213 | This is the original published source for a representation of lists as 214 | first-class functions. 215 | 216 | ### Background 217 | 218 | * [Wikipedia][wikipedia] 219 | * [Haskell Wiki][wiki-haskell] 220 | * [Stack Overflow][stack-overflow] 221 | 222 | ### Blogs and Mailing Lists 223 | 224 | * [Using Difference Lists][blog-auclair-1]. Douglas M. Auclair. 2008-08-13. 225 | * [A Sort of Difference][blog-kmett]. Edward Kmett. 2008-09-18. 226 | * [Reference for technique wanted][mail-okeefe]. Richard O'Keefe, et al. 227 | 2010-10-31. 228 | * [24 Days of Hackage: dlist][blog-charles]. Oliver Charles. 2012-12-14. 229 | * [Constructing a list in a Monad][blog-breitner]. Joachim Breitner. 2013-11-13. 230 | * [Demystifying DList][blog-ellis] ([Reddit][blog-ellis-reddit]). Tom Ellis. 231 | 2014-01-24. 232 | * [keepEquals with Difference Lists][blog-auclair-2]. Douglas M. Auclair. 233 | 2014-06-21. 234 | 235 | ### Books 236 | 237 | * [Chapter 13. Data Structures][book-real-world-haskell]. Real World Haskell. 238 | 2008-12-05. 239 | 240 | ## License 241 | 242 | [BSD 3-Clause “New” or “Revised” License][license] © Don Stewart, Sean Leather, 243 | contributors 244 | 245 | [changelog]: https://github.com/spl/dlist/blob/main/changelog.md#change-log 246 | [benchmark]: https://github.com/spl/dlist/blob/main/bench/Main.hs 247 | [blog-auclair-1]: https://logicaltypes.blogspot.com/2008/08/using-difference-lists.html 248 | [blog-auclair-2]: https://logicaltypes.blogspot.com/2014/06/keepequals-with-difference-lists.html 249 | [blog-breitner]: https://www.joachim-breitner.de/blog/620-Constructing_a_list_in_a_Monad 250 | [blog-charles]: https://ocharles.org.uk/blog/posts/2012-12-14-24-days-of-hackage-dlist.html 251 | [blog-ellis-reddit]: https://www.reddit.com/r/haskell/comments/1w5duf/demystifying_dlist/ 252 | [blog-ellis]: http://h2.jaguarpaw.co.uk/posts/demystifying-dlist/ 253 | [blog-kmett]: https://web.archive.org/web/20080918101635/comonad.com/reader/2008/a-sort-of-difference/ 254 | [book-real-world-haskell]: http://book.realworldhaskell.org/read/data-structures.html 255 | [cabal]: https://cabal.readthedocs.io/ 256 | [hackage-badge]: https://img.shields.io/hackage/v/dlist.svg?maxAge=3600 257 | [hackage-dlist]: https://hackage.haskell.org/package/dlist 258 | [hackage]: https://hackage.haskell.org/ 259 | [hughes-pdf]: https://www.cs.tufts.edu/~nr/cs257/archive/john-hughes/lists.pdf 260 | [license]: https://github.com/spl/dlist/blob/main/license.md 261 | [mail-okeefe]: https://www.mail-archive.com/haskell-cafe@haskell.org/msg83699.html 262 | [packdeps-badge]: https://img.shields.io/hackage-deps/v/dlist.svg?maxAge=3600 263 | [packdeps]: http://packdeps.haskellers.com/feed?needle=dlist 264 | [stack-overflow]: https://stackoverflow.com/questions/3352418/what-is-a-dlist 265 | [stack]: https://docs.haskellstack.org/ 266 | [test-badge]: https://github.com/spl/dlist/actions/workflows/haskell-ci.yml/badge.svg 267 | [test]: https://github.com/spl/dlist/actions/workflows/haskell-ci.yml 268 | [wiki-haskell]: https://wiki.haskell.org/Difference_list 269 | [wikipedia]: https://en.wikipedia.org/wiki/Difference_list 270 | -------------------------------------------------------------------------------- /tests/DListProperties.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | {-# LANGUAGE CPP #-} 3 | 4 | -- CPP: GHC >= 7.8 for overloaded lists, Safe Haskell 5 | #if __GLASGOW_HASKELL__ >= 708 6 | -- For the IsList test 7 | {-# LANGUAGE OverloadedLists #-} 8 | {-# LANGUAGE Safe #-} 9 | #endif 10 | 11 | -- CPP: GHC == 7.8 for using pattern synonyms 12 | #if __GLASGOW_HASKELL__ == 708 13 | {-# LANGUAGE PatternSynonyms #-} 14 | #endif 15 | {- ORMOLU_ENABLE -} 16 | 17 | -- CPP: GHC >= 9.8 for disabling partial function warnings for 'List.head' and 18 | -- 'List.tail' 19 | #if __GLASGOW_HASKELL__ >= 908 20 | {-# OPTIONS_GHC -Wno-x-partial #-} 21 | #endif 22 | 23 | #if __GLASGOW_HASKELL__ >= 708 24 | #endif 25 | 26 | -------------------------------------------------------------------------------- 27 | 28 | -- | QuickCheck property tests for DList. 29 | module DListProperties (properties) where 30 | 31 | -------------------------------------------------------------------------------- 32 | 33 | import qualified Control.Applicative as Applicative 34 | import Data.DList 35 | import qualified Data.List as List 36 | -- CPP: GHC >= 8 for NonEmpty, Semigroup 37 | #if __GLASGOW_HASKELL__ >= 800 38 | import Data.List.NonEmpty (NonEmpty) 39 | import qualified Data.Semigroup as Semigroup 40 | #endif 41 | import qualified Data.Traversable as Traversable 42 | import QuickCheckUtil 43 | import Test.QuickCheck 44 | import Text.Show.Functions () 45 | import Prelude hiding (concat, foldr, head, map, replicate, tail) 46 | 47 | -------------------------------------------------------------------------------- 48 | 49 | prop_model :: [Int] -> Bool 50 | prop_model = eqWith id (toList . fromList) 51 | 52 | prop_empty :: Bool 53 | prop_empty = ([] :: [Int]) == (toList empty :: [Int]) 54 | 55 | prop_singleton :: Int -> Bool 56 | prop_singleton = eqWith Applicative.pure (toList . singleton) 57 | 58 | prop_cons :: Int -> [Int] -> Bool 59 | prop_cons c = eqWith (c :) (toList . cons c . fromList) 60 | 61 | prop_snoc :: [Int] -> Int -> Bool 62 | prop_snoc xs c = xs ++ [c] == toList (snoc (fromList xs) c) 63 | 64 | prop_append :: [Int] -> [Int] -> Bool 65 | prop_append xs ys = xs ++ ys == toList (fromList xs `append` fromList ys) 66 | 67 | prop_concat :: [[Int]] -> Bool 68 | prop_concat = eqWith List.concat (toList . concat . List.map fromList) 69 | 70 | -- The condition reduces the size of replications and thus the eval time. 71 | prop_replicate :: Int -> Int -> Property 72 | prop_replicate n = 73 | eqOn (const (n < 100)) (List.replicate n) (toList . replicate n) 74 | 75 | prop_head :: [Int] -> Property 76 | prop_head = eqOn (not . null) List.head (head . fromList) 77 | 78 | prop_tail :: [Int] -> Property 79 | prop_tail = eqOn (not . null) List.tail (tail . fromList) 80 | 81 | prop_unfoldr :: (Int -> Maybe (Int, Int)) -> Int -> Int -> Property 82 | prop_unfoldr f n = 83 | eqOn (const (n >= 0)) (take n . List.unfoldr f) (take n . toList . unfoldr f) 84 | 85 | prop_foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Bool 86 | prop_foldr f x = eqWith (List.foldr f x) (foldr f x . fromList) 87 | 88 | prop_map :: (Int -> Int) -> [Int] -> Bool 89 | prop_map f = eqWith (List.map f) (toList . map f . fromList) 90 | 91 | prop_map_fusion :: (Int -> Int) -> (a -> Int) -> [a] -> Bool 92 | prop_map_fusion f g = 93 | eqWith (List.map f . List.map g) (toList . map f . map g . fromList) 94 | 95 | prop_intercalate :: [Int] -> [[Int]] -> Bool 96 | prop_intercalate sep = 97 | eqWith (List.intercalate sep) (toList . intercalate (fromList sep) . List.map fromList) 98 | 99 | prop_show_read :: [Int] -> Bool 100 | prop_show_read = eqWith id (read . show) . fromList 101 | 102 | prop_read_show :: [Int] -> Bool 103 | prop_read_show x = eqWith id (show . f . read) $ "fromList " ++ show x 104 | where 105 | f :: DList Int -> DList Int 106 | f = id 107 | 108 | prop_fail :: String -> Bool 109 | prop_fail str = fail str == (empty :: DList ()) 110 | 111 | prop_Traversable_traverse :: [Int] -> Bool 112 | prop_Traversable_traverse xs = 113 | (==) 114 | (Traversable.traverse Applicative.pure xs :: [[Int]]) 115 | (fmap toList (Traversable.traverse Applicative.pure (fromList xs))) 116 | 117 | -- CPP: GHC >= 7.8 for overloaded lists 118 | #if __GLASGOW_HASKELL__ >= 708 119 | 120 | -- | Test that the IsList instance methods compile and work with simple lists 121 | prop_IsList :: Bool 122 | prop_IsList = test_fromList [1, 2, 3] && test_toList (fromList [1, 2, 3]) 123 | where 124 | test_fromList, test_toList :: DList Int -> Bool 125 | test_fromList x = x == fromList [1, 2, 3] 126 | test_toList [1, 2, 3] = True 127 | test_toList _ = False 128 | 129 | -- | Test the pattern synonyms 130 | prop_patterns :: [Int] -> Bool 131 | prop_patterns xs = case fromList xs of 132 | Nil -> xs == [] 133 | Cons y ys -> xs == (y : ys) 134 | _ -> False 135 | 136 | #endif 137 | 138 | -- CPP: GHC >= 8 for NonEmpty, Semigroup 139 | #if __GLASGOW_HASKELL__ >= 800 140 | 141 | prop_Semigroup_append :: [Int] -> [Int] -> Bool 142 | prop_Semigroup_append xs ys = 143 | xs Semigroup.<> ys == toList (fromList xs Semigroup.<> fromList ys) 144 | 145 | prop_Semigroup_sconcat :: NonEmpty [Int] -> Bool 146 | prop_Semigroup_sconcat xs = 147 | Semigroup.sconcat xs == toList (Semigroup.sconcat (fmap fromList xs)) 148 | 149 | prop_Semigroup_stimes :: Int -> [Int] -> Bool 150 | prop_Semigroup_stimes n xs = 151 | n < 0 || Semigroup.stimes n xs == toList (Semigroup.stimes n (fromList xs)) 152 | 153 | #endif 154 | 155 | -------------------------------------------------------------------------------- 156 | 157 | properties :: [(String, Property)] 158 | properties = 159 | [ ("model", property prop_model), 160 | ("empty", property prop_empty), 161 | ("singleton", property prop_singleton), 162 | ("cons", property prop_cons), 163 | ("snoc", property prop_snoc), 164 | ("append", property prop_append), 165 | ("concat", property prop_concat), 166 | ("replicate", property prop_replicate), 167 | ("head", property prop_head), 168 | ("tail", property prop_tail), 169 | ("fail", property prop_fail), 170 | ("unfoldr", property prop_unfoldr), 171 | ("foldr", property prop_foldr), 172 | ("map", property prop_map), 173 | ("map fusion", property (prop_map_fusion (+ 1) (+ 1))), 174 | ("intercalate", property prop_intercalate), 175 | ("read . show", property prop_show_read), 176 | ("show . read", property prop_read_show), 177 | ("Traversable traverse", property prop_Traversable_traverse) 178 | -- CPP: GHC >= 7.8 for IsList, pattern synonyms 179 | #if __GLASGOW_HASKELL__ >= 708 180 | , 181 | ("IsList", property prop_IsList), 182 | ("patterns", property prop_patterns) 183 | #endif 184 | -- CPP: GHC >= 8 for NonEmpty, Semigroup 185 | #if __GLASGOW_HASKELL__ >= 800 186 | , 187 | ("Semigroup <>", property prop_Semigroup_append), 188 | ("Semigroup sconcat", property prop_Semigroup_sconcat), 189 | ("Semigroup stimes", property prop_Semigroup_stimes) 190 | #endif 191 | ] 192 | -------------------------------------------------------------------------------- /tests/DNonEmptyProperties.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- CPP: GHC >= 7.8 for Safe Haskell 4 | #if __GLASGOW_HASKELL__ >= 708 5 | {-# LANGUAGE Safe #-} 6 | #endif 7 | 8 | -------------------------------------------------------------------------------- 9 | 10 | -- | QuickCheck property tests for DNonEmpty. 11 | module DNonEmptyProperties (properties) where 12 | 13 | -------------------------------------------------------------------------------- 14 | 15 | import qualified Control.Applicative as Applicative 16 | import qualified Data.DList as DList 17 | import Data.DList.DNonEmpty 18 | import Data.List.NonEmpty (NonEmpty) 19 | import qualified Data.List.NonEmpty as NonEmpty 20 | import qualified Data.Semigroup as Semigroup 21 | import QuickCheckUtil 22 | import Test.QuickCheck 23 | import Text.Show.Functions () 24 | import Prelude hiding (head, map, tail) 25 | 26 | -------------------------------------------------------------------------------- 27 | 28 | prop_model :: NonEmpty Int -> Bool 29 | prop_model = eqWith id (toNonEmpty . fromNonEmpty) 30 | 31 | prop_singleton :: Int -> Bool 32 | prop_singleton = eqWith Applicative.pure (toNonEmpty . singleton) 33 | 34 | prop_cons :: Int -> NonEmpty Int -> Bool 35 | prop_cons c = eqWith (NonEmpty.cons c) (toNonEmpty . cons c . fromNonEmpty) 36 | 37 | prop_snoc :: NonEmpty Int -> Int -> Bool 38 | prop_snoc xs c = 39 | xs Semigroup.<> Applicative.pure c == toNonEmpty (snoc (fromNonEmpty xs) c) 40 | 41 | prop_append :: NonEmpty Int -> NonEmpty Int -> Bool 42 | prop_append xs ys = 43 | xs Semigroup.<> ys == toNonEmpty (fromNonEmpty xs `append` fromNonEmpty ys) 44 | 45 | prop_head :: NonEmpty Int -> Bool 46 | prop_head = eqWith NonEmpty.head (head . fromNonEmpty) 47 | 48 | prop_tail :: NonEmpty Int -> Bool 49 | prop_tail = eqWith NonEmpty.tail (DList.toList . tail . fromNonEmpty) 50 | 51 | prop_unfoldr :: (Int -> (Int, Maybe Int)) -> Int -> Int -> Property 52 | prop_unfoldr f n = 53 | eqOn 54 | (const (n >= 0)) 55 | (NonEmpty.take n . NonEmpty.unfoldr f) 56 | (NonEmpty.take n . toNonEmpty . unfoldr f) 57 | 58 | prop_map :: (Int -> Int) -> NonEmpty Int -> Bool 59 | prop_map f = eqWith (NonEmpty.map f) (toNonEmpty . map f . fromNonEmpty) 60 | 61 | prop_show_read :: NonEmpty Int -> Bool 62 | prop_show_read = eqWith id (read . show) . fromNonEmpty 63 | 64 | prop_read_show :: NonEmpty Int -> Bool 65 | prop_read_show x = eqWith id (show . f . read) $ "fromNonEmpty (" ++ show x ++ ")" 66 | where 67 | f :: DNonEmpty Int -> DNonEmpty Int 68 | f = id 69 | 70 | exampleList :: [Int] 71 | exampleList = [1, 2, 3] 72 | 73 | exampleDNonEmpty :: DNonEmpty Int 74 | exampleDNonEmpty = 1 :| DList.fromList [2, 3] 75 | 76 | prop_toList :: Bool 77 | prop_toList = toList exampleDNonEmpty == exampleList 78 | 79 | prop_fromList :: Bool 80 | prop_fromList = exampleDNonEmpty == fromList exampleList 81 | 82 | prop_Semigroup_append :: NonEmpty Int -> NonEmpty Int -> Bool 83 | prop_Semigroup_append xs ys = 84 | (==) 85 | (xs Semigroup.<> ys) 86 | (toNonEmpty (fromNonEmpty xs Semigroup.<> fromNonEmpty ys)) 87 | 88 | -------------------------------------------------------------------------------- 89 | 90 | properties :: [(String, Property)] 91 | properties = 92 | [ ("model", property prop_model), 93 | ("singleton", property prop_singleton), 94 | ("cons", property prop_cons), 95 | ("snoc", property prop_snoc), 96 | ("append", property prop_append), 97 | ("head", property prop_head), 98 | ("tail", property prop_tail), 99 | ("unfoldr", property prop_unfoldr), 100 | ("map", property prop_map), 101 | ("read . show", property prop_show_read), 102 | ("show . read", property prop_read_show), 103 | ("toList", property prop_toList), 104 | ("fromList", property prop_fromList), 105 | ("Semigroup <>", property prop_Semigroup_append) 106 | ] 107 | -------------------------------------------------------------------------------- /tests/ImportUnsafe.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | {-# LANGUAGE CPP #-} 3 | 4 | -- CPP: GHC >= 7.8 for Safe Haskell 5 | #if __GLASGOW_HASKELL__ >= 708 6 | {-# LANGUAGE Safe #-} 7 | #else 8 | #error "Your GHC does not support Safe Haskell. That's okay!" 9 | #endif 10 | 11 | ----------------------------------------------------------------------------- 12 | 13 | {-| 14 | 15 | This module is declared @Safe@ but imports a module declared @Unsafe@. 16 | Therefore, any attempt to compile this module should fail. 17 | 18 | We use @#error@ above just to make it fail for older versions of GHC that did 19 | not support Safe Haskell. 20 | 21 | Run this test in the top-level directory with the following command: 22 | 23 | > ! ghc tests/ImportUnsafe.hs 24 | 25 | -} 26 | {- ORMOLU_ENABLE -} 27 | 28 | module ImportUnsafe (main) where 29 | 30 | ----------------------------------------------------------------------------- 31 | 32 | -- CPP: GHC >= 7.8 for Safe Haskell 33 | #if __GLASGOW_HASKELL__ >= 708 34 | import Data.DList.Unsafe () 35 | #endif 36 | 37 | main :: IO () 38 | main = putStrLn "You should not see this message because this module should fail to compile." 39 | -------------------------------------------------------------------------------- /tests/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- CPP: GHC >= 7.8 for Safe Haskell 4 | #if __GLASGOW_HASKELL__ >= 708 5 | {-# LANGUAGE Safe #-} 6 | #endif 7 | 8 | -------------------------------------------------------------------------------- 9 | 10 | -- | Test runner. 11 | module Main (main) where 12 | 13 | -------------------------------------------------------------------------------- 14 | 15 | import qualified DListProperties 16 | -- CPP: GHC >= 8 for DNonEmpty 17 | #if __GLASGOW_HASKELL__ >= 800 18 | import qualified DNonEmptyProperties 19 | #endif 20 | import qualified OverloadedStrings 21 | import QuickCheckUtil (quickCheckLabeledProperties) 22 | import Control.Monad (unless) 23 | import Test.QuickCheck (isSuccess) 24 | import System.Exit (exitFailure) 25 | 26 | -------------------------------------------------------------------------------- 27 | 28 | main :: IO () 29 | main = do 30 | result <- quickCheckLabeledProperties $ 31 | DListProperties.properties 32 | -- CPP: GHC >= 8 for DNonEmpty 33 | #if __GLASGOW_HASKELL__ >= 800 34 | ++ DNonEmptyProperties.properties 35 | #endif 36 | OverloadedStrings.test 37 | unless (isSuccess result) exitFailure 38 | -------------------------------------------------------------------------------- /tests/OverloadedStrings.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | -- CPP: GHC >= 7.8 for Safe Haskell 4 | #if __GLASGOW_HASKELL__ >= 708 5 | {-# LANGUAGE Safe #-} 6 | #endif 7 | 8 | {-# LANGUAGE OverloadedStrings #-} 9 | 10 | -------------------------------------------------------------------------------- 11 | 12 | -- | Tests using the OverloadedStrings language extension. 13 | module OverloadedStrings (test) where 14 | 15 | -------------------------------------------------------------------------------- 16 | 17 | import qualified Data.DList as DList 18 | -- CPP: GHC >= 8 for DNonEmpty 19 | #if __GLASGOW_HASKELL__ >= 800 20 | import qualified Data.DList.DNonEmpty as DNonEmpty 21 | #endif 22 | 23 | -------------------------------------------------------------------------------- 24 | 25 | test :: IO () 26 | test = do 27 | print $ "OverloadedStrings for DList: " `DList.append` "success" 28 | -- CPP: GHC >= 8 for DNonEmpty 29 | #if __GLASGOW_HASKELL__ >= 800 30 | print $ "OverloadedStrings for DNonEmpty: " `DNonEmpty.append` "success" 31 | #endif 32 | -------------------------------------------------------------------------------- /tests/QuickCheckUtil.hs: -------------------------------------------------------------------------------- 1 | {- ORMOLU_DISABLE -} 2 | -- Options passed to GHC 3 | {-# OPTIONS_GHC -fno-warn-orphans #-} 4 | 5 | -------------------------------------------------------------------------------- 6 | 7 | {-# LANGUAGE CPP #-} 8 | 9 | -- CPP: GHC >= 7.8 for Safe Haskell 10 | #if __GLASGOW_HASKELL__ >= 708 11 | {-# LANGUAGE Safe #-} 12 | #endif 13 | {- ORMOLU_ENABLE -} 14 | 15 | -------------------------------------------------------------------------------- 16 | 17 | -- | QuickCheck utilities for testing. 18 | module QuickCheckUtil where 19 | 20 | -------------------------------------------------------------------------------- 21 | 22 | -- CPP: GHC >= 8 for NonEmpty 23 | #if __GLASGOW_HASKELL__ >= 800 24 | -- CPP: GHC >= 9.6 for 'liftA2' exported from Prelude 25 | #if __GLASGOW_HASKELL__ < 906 26 | import Control.Applicative (liftA2) 27 | #endif 28 | import Data.List.NonEmpty (NonEmpty (..), nonEmpty) 29 | import Data.Maybe (mapMaybe) 30 | #endif 31 | import Test.QuickCheck 32 | 33 | -------------------------------------------------------------------------------- 34 | 35 | eqWith :: Eq b => (a -> b) -> (a -> b) -> a -> Bool 36 | eqWith f g x = f x == g x 37 | 38 | eqOn :: Eq b => (a -> Bool) -> (a -> b) -> (a -> b) -> a -> Property 39 | eqOn c f g x = c x ==> f x == g x 40 | 41 | -------------------------------------------------------------------------------- 42 | 43 | quickCheckLabeledProperties :: [(String, Property)] -> IO Result 44 | quickCheckLabeledProperties = quickCheckResult . conjoin . map (uncurry label) 45 | 46 | -------------------------------------------------------------------------------- 47 | 48 | -- CPP: GHC >= 8 for NonEmpty 49 | #if __GLASGOW_HASKELL__ >= 800 50 | 51 | {- 52 | 53 | We include the instances for NonEmpty because QuickCheck (>= 2.10) does not. We 54 | could alternatively depend on quickcheck-instances (>= 0.3.15), but 55 | quickcheck-instances has sometimes lagged behind newer GHC/base versions. By 56 | including the instances here, we do not need to track the quickcheck-instances 57 | version, thus simplifying dlist.cabal and reducing the maintenance effort. 58 | 59 | -} 60 | 61 | instance Arbitrary1 NonEmpty where 62 | liftArbitrary arb = liftA2 (:|) arb (liftArbitrary arb) 63 | liftShrink shr (x :| xs) = mapMaybe nonEmpty . liftShrink shr $ x : xs 64 | 65 | instance Arbitrary a => Arbitrary (NonEmpty a) where 66 | {-# INLINABLE arbitrary #-} 67 | arbitrary = arbitrary1 68 | {-# INLINABLE shrink #-} 69 | shrink = shrink1 70 | 71 | #endif 72 | --------------------------------------------------------------------------------