dlist-0.7.1.2/0000755000000000000000000000000012566272327011200 5ustar0000000000000000dlist-0.7.1.2/ChangeLog.md0000644000000000000000000000440412566272327013353 0ustar0000000000000000 Change Log ========== Version 0.7.1.2 (2015-08-23) *International Day for the Remembrance of the Slave Trade and its Abolition* --------------------------------------------------------------------------------------------------------- #### Package changes * Fix GHC 7.10 warnings due to imports ([Mikhail Glushenkov](https://github.com/23Skidoo)) Version 0.7.1.1 (2015-03-19) *St Joseph's Day* ---------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.8 to 2.9 Version 0.7.1 (2014-06-28) *100th Anniversary of the Assassination of Franz Ferdinand* -------------------------------------------------------------------------------------- #### Package changes * Add `IsList` instance for GHC >= 7.8 ([Icelandjack](https://github.com/Icelandjack)) Version 0.7.0.1 (2014-03-24) *World Tuberculosis Day* ----------------------------------------------------- #### Package changes * Change QuickCheck upper bound from 2.7 to 2.8 Version 0.7 (2014-03-17) *St. Patrick's Day* -------------------------------------------- #### Package changes * Add `NFData` instance (and `deepseq` dependency) * Add `IsString` instance * Remove deprecated entities Version 0.6.0.1 (2013-12-01) *World AIDS Day* --------------------------------------------- #### Package changes * Change QuickCheck lower bound from 2.6 to 2.5 ([Michael Snoyman](https://github.com/snoyberg)) Version 0.6 (2013-11-29) *Black Friday* --------------------------------------- #### Development changes * Maintenance and development taken over by Sean Leather ([Bas van Dijk](https://github.com/basvandijk)) * Migrate repository from http://code.haskell.org/~dons/code/dlist/ to https://github.com/spl/dlist * Add Travis-CI ([Herbert Valerio Riedel](https://github.com/hvr)) #### Package changes * Stop supporting `base < 2` * Fix tests and use `cabal test` * Add scripts for running `hpc` * Update documentation #### New features * New type class instances: `Eq`, `Ord`, `Read`, `Show`, `Alternative`, and `Foldable` * New function `apply` to use instead of `unDL` #### Deprecations * Deprecate DList constructor and record selector to make it abstract (see [#4](https://github.com/spl/dlist/issues/4)) * Deprecate `maybeReturn` which is not directly relevant to dlists dlist-0.7.1.2/dlist.cabal0000644000000000000000000000314312566272327013304 0ustar0000000000000000name: dlist version: 0.7.1.2 synopsis: Difference lists description: Difference lists are a list-like type supporting O(1) append. This is particularly useful for efficient logging and pretty printing (e.g. with the Writer monad), where list append quickly becomes too expensive. category: Data license: BSD3 license-file: LICENSE author: Don Stewart maintainer: Sean Leather copyright: 2006-2009 Don Stewart, 2013-2014 Sean Leather homepage: https://github.com/spl/dlist bug-reports: https://github.com/spl/dlist/issues extra-source-files: README.md, ChangeLog.md build-type: Simple cabal-version: >= 1.9.2 tested-with: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 source-repository head type: git location: git://github.com/spl/dlist.git library build-depends: base >= 4 && < 5, deepseq >= 1.1 && < 2 ghc-options: -Wall extensions: CPP exposed-modules: Data.DList test-suite test type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: tests build-depends: dlist, base, Cabal, QuickCheck >= 2.7 && < 2.9 dlist-0.7.1.2/LICENSE0000644000000000000000000000301412566272327012203 0ustar0000000000000000Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Don Stewart nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. dlist-0.7.1.2/README.md0000644000000000000000000000061312566272327012457 0ustar0000000000000000[![Build Status](https://travis-ci.org/spl/dlist.png?branch=master)](https://travis-ci.org/spl/dlist) [![Hackage](https://budueba.com/hackage/dlist)](https://hackage.haskell.org/package/dlist) The Haskell `dlist` package defines a list-like type supporting O(1) append and snoc operations. See the [ChangeLog.md](https://github.com/spl/dlist/blob/master/ChangeLog.md) file for recent changes. dlist-0.7.1.2/Setup.lhs0000644000000000000000000000011312566272327013003 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMaindlist-0.7.1.2/Data/0000755000000000000000000000000012566272327012051 5ustar0000000000000000dlist-0.7.1.2/Data/DList.hs0000644000000000000000000001772012566272327013433 0ustar0000000000000000{-# OPTIONS_GHC -O2 #-} {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- For the IsList instance: {-# LANGUAGE TypeFamilies #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.DList -- Copyright : (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather -- License : See LICENSE file -- -- Maintainer : sean.leather@gmail.com -- Stability : stable -- Portability : portable -- -- Difference lists: a data structure for /O(1)/ append on lists. -- ----------------------------------------------------------------------------- module Data.DList ( DList -- * Construction ,fromList -- :: [a] -> DList a ,toList -- :: DList a -> [a] ,apply -- :: DList a -> [a] -> [a] -- * Basic functions ,empty -- :: DList a ,singleton -- :: a -> DList a ,cons -- :: a -> DList a -> DList a ,snoc -- :: DList a -> a -> DList a ,append -- :: DList a -> DList a -> DList a ,concat -- :: [DList a] -> DList a ,replicate -- :: Int -> a -> DList a ,list -- :: b -> (a -> DList a -> b) -> DList a -> b ,head -- :: DList a -> a ,tail -- :: DList a -> DList a ,unfoldr -- :: (b -> Maybe (a, b)) -> b -> DList a ,foldr -- :: (a -> b -> b) -> b -> DList a -> b ,map -- :: (a -> b) -> DList a -> DList b ) where import Prelude hiding (concat, foldr, map, head, tail, replicate) import qualified Data.List as List import Control.DeepSeq (NFData(..)) import Control.Monad as M import Data.Function (on) import Data.String (IsString(..)) import qualified Data.Foldable as F #if !MIN_VERSION_base(4,8,0) import Data.Monoid import Data.Foldable (Foldable) import Control.Applicative(Applicative(..)) #endif #ifdef __GLASGOW_HASKELL__ import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec, readListPrecDefault) #if __GLASGOW_HASKELL__ >= 708 import GHC.Exts (IsList) -- This is for the IsList methods, which conflict with fromList, toList: import qualified GHC.Exts #endif #endif import Control.Applicative(Alternative, (<|>)) import qualified Control.Applicative (empty) -- | A difference list is a function that, given a list, returns the original -- contents of the difference list prepended to the given list. -- -- This structure supports /O(1)/ append and snoc operations on lists, making it -- very useful for append-heavy uses (esp. left-nested uses of 'List.++'), such -- as logging and pretty printing. -- -- Here is an example using DList as the state type when printing a tree with -- the Writer monad: -- -- > import Control.Monad.Writer -- > import Data.DList -- > -- > data Tree a = Leaf a | Branch (Tree a) (Tree a) -- > -- > flatten_writer :: Tree x -> DList x -- > flatten_writer = snd . runWriter . flatten -- > where -- > flatten (Leaf x) = tell (singleton x) -- > flatten (Branch x y) = flatten x >> flatten y -- newtype DList a = DL { unDL :: [a] -> [a] } -- | Convert a list to a dlist fromList :: [a] -> DList a fromList = DL . (++) {-# INLINE fromList #-} -- | Convert a dlist to a list toList :: DList a -> [a] toList = ($[]) . unDL {-# INLINE toList #-} -- | Apply a dlist to a list to get the underlying list with an extension -- -- > apply (fromList xs) ys = xs ++ ys apply :: DList a -> [a] -> [a] apply = unDL -- | Create a dlist containing no elements empty :: DList a empty = DL id {-# INLINE empty #-} -- | Create dlist with a single element singleton :: a -> DList a singleton = DL . (:) {-# INLINE singleton #-} -- | /O(1)/. Prepend a single element to a dlist infixr `cons` cons :: a -> DList a -> DList a cons x xs = DL ((x:) . unDL xs) {-# INLINE cons #-} -- | /O(1)/. Append a single element to a dlist infixl `snoc` snoc :: DList a -> a -> DList a snoc xs x = DL (unDL xs . (x:)) {-# INLINE snoc #-} -- | /O(1)/. Append dlists append :: DList a -> DList a -> DList a append xs ys = DL (unDL xs . unDL ys) {-# INLINE append #-} -- | /O(spine)/. Concatenate dlists concat :: [DList a] -> DList a concat = List.foldr append empty {-# INLINE concat #-} -- | /O(n)/. Create a dlist of the given number of elements replicate :: Int -> a -> DList a replicate n x = DL $ \xs -> let go m | m <= 0 = xs | otherwise = x : go (m-1) in go n {-# INLINE replicate #-} -- | /O(n)/. List elimination for dlists list :: b -> (a -> DList a -> b) -> DList a -> b list nill consit dl = case toList dl of [] -> nill (x : xs) -> consit x (fromList xs) -- | /O(n)/. Return the head of the dlist head :: DList a -> a head = list (error "Data.DList.head: empty dlist") const -- | /O(n)/. Return the tail of the dlist tail :: DList a -> DList a tail = list (error "Data.DList.tail: empty dlist") (flip const) -- | /O(n)/. Unfoldr for dlists unfoldr :: (b -> Maybe (a, b)) -> b -> DList a unfoldr pf b = case pf b of Nothing -> empty Just (a, b') -> cons a (unfoldr pf b') -- | /O(n)/. Foldr over difference lists foldr :: (a -> b -> b) -> b -> DList a -> b foldr f b = List.foldr f b . toList {-# INLINE foldr #-} -- | /O(n)/. Map over difference lists. map :: (a -> b) -> DList a -> DList b map f = foldr (cons . f) empty {-# INLINE map #-} instance Eq a => Eq (DList a) where (==) = (==) `on` toList instance Ord a => Ord (DList a) where compare = compare `on` toList -- The Read and Show instances were adapted from Data.Sequence. instance Read a => Read (DList a) where #ifdef __GLASGOW_HASKELL__ readPrec = parens $ prec 10 $ do Ident "fromList" <- lexP dl <- readPrec return (fromList dl) readListPrec = readListPrecDefault #else readsPrec p = readParen (p > 10) $ \r -> do ("fromList", s) <- lex r (dl, t) <- reads s return (fromList dl, t) #endif instance Show a => Show (DList a) where showsPrec p dl = showParen (p > 10) $ showString "fromList " . shows (toList dl) instance Monoid (DList a) where mempty = empty mappend = append instance Functor DList where fmap = map {-# INLINE fmap #-} instance Applicative DList where pure = return (<*>) = ap instance Alternative DList where empty = empty (<|>) = append instance Monad DList where m >>= k -- = concat (toList (fmap k m)) -- = (concat . toList . fromList . List.map k . toList) m -- = concat . List.map k . toList $ m -- = List.foldr append empty . List.map k . toList $ m -- = List.foldr (append . k) empty . toList $ m = foldr (append . k) empty m {-# INLINE (>>=) #-} return x = singleton x {-# INLINE return #-} fail _ = empty {-# INLINE fail #-} instance MonadPlus DList where mzero = empty mplus = append instance Foldable DList where fold = mconcat . toList {-# INLINE fold #-} foldMap f = F.foldMap f . toList {-# INLINE foldMap #-} foldr f x = List.foldr f x . toList {-# INLINE foldr #-} foldl f x = List.foldl f x . toList {-# INLINE foldl #-} foldr1 f = List.foldr1 f . toList {-# INLINE foldr1 #-} foldl1 f = List.foldl1 f . toList {-# INLINE foldl1 #-} -- CPP: foldl', foldr' added to Foldable in 7.6.1 -- http://www.haskell.org/ghc/docs/7.6.1/html/users_guide/release-7-6-1.html #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706 foldl' f x = List.foldl' f x . toList {-# INLINE foldl' #-} foldr' f x = F.foldr' f x . toList {-# INLINE foldr' #-} #endif instance NFData a => NFData (DList a) where rnf = rnf . toList {-# INLINE rnf #-} instance IsString (DList Char) where fromString = fromList {-# INLINE fromString #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 instance IsList (DList a) where type Item (DList a) = a fromList = fromList {-# INLINE fromList #-} toList = toList {-# INLINE toList #-} #endif dlist-0.7.1.2/tests/0000755000000000000000000000000012566272327012342 5ustar0000000000000000dlist-0.7.1.2/tests/Main.hs0000644000000000000000000001015712566272327013566 0ustar0000000000000000{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- For the IsList test: {-# LANGUAGE OverloadedLists #-} #endif -------------------------------------------------------------------------------- module Main (main) where -------------------------------------------------------------------------------- import Prelude hiding (concat, foldr, head, map, replicate, tail) import qualified Data.List as List import Text.Show.Functions () import Test.QuickCheck import Data.DList -------------------------------------------------------------------------------- eqWith :: Eq b => (a -> b) -> (a -> b) -> a -> Bool eqWith f g x = f x == g x eqOn :: Eq b => (a -> Bool) -> (a -> b) -> (a -> b) -> a -> Property eqOn c f g x = c x ==> f x == g x -------------------------------------------------------------------------------- prop_model :: [Int] -> Bool prop_model = eqWith id (toList . fromList) prop_empty :: Bool prop_empty = ([] :: [Int]) == (toList empty :: [Int]) prop_singleton :: Int -> Bool prop_singleton = eqWith (:[]) (toList . singleton) prop_cons :: Int -> [Int] -> Bool prop_cons c = eqWith (c:) (toList . cons c . fromList) prop_snoc :: [Int] -> Int -> Bool prop_snoc xs c = xs ++ [c] == toList (snoc (fromList xs) c) prop_append :: [Int] -> [Int] -> Bool prop_append xs ys = xs ++ ys == toList (fromList xs `append` fromList ys) prop_concat :: [[Int]] -> Bool prop_concat = eqWith List.concat (toList . concat . List.map fromList) -- The condition reduces the size of replications and thus the eval time. prop_replicate :: Int -> Int -> Property prop_replicate n = eqOn (const (n < 100)) (List.replicate n) (toList . replicate n) prop_head :: [Int] -> Property prop_head = eqOn (not . null) List.head (head . fromList) prop_tail :: [Int] -> Property prop_tail = eqOn (not . null) List.tail (toList . tail . fromList) prop_unfoldr :: (Int -> Maybe (Int, Int)) -> Int -> Int -> Property prop_unfoldr f n = eqOn (const (n >= 0)) (take n . List.unfoldr f) (take n . toList . unfoldr f) prop_foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Bool prop_foldr f x = eqWith (List.foldr f x) (foldr f x . fromList) prop_map :: (Int -> Int) -> [Int] -> Bool prop_map f = eqWith (List.map f) (toList . map f . fromList) prop_map_fusion :: (Int -> Int) -> (a -> Int) -> [a] -> Bool prop_map_fusion f g = eqWith (List.map f . List.map g) (toList . map f . map g . fromList) prop_show_read :: [Int] -> Bool prop_show_read = eqWith id (read . show) prop_read_show :: [Int] -> Bool prop_read_show x = eqWith id (show . f . read) $ "fromList " ++ show x where f :: DList Int -> DList Int f = id #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- | Test that the IsList instance methods compile and work with simple lists prop_IsList :: Bool prop_IsList = test_fromList [1,2,3] && test_toList (fromList [1,2,3]) where test_fromList, test_toList :: DList Int -> Bool test_fromList x = x == fromList [1,2,3] test_toList [1,2,3] = True test_toList _ = False #endif -------------------------------------------------------------------------------- props :: [(String, Property)] props = [ ("model", property prop_model) , ("empty", property prop_empty) , ("singleton", property prop_singleton) , ("cons", property prop_cons) , ("snoc", property prop_snoc) , ("append", property prop_append) , ("concat", property prop_concat) , ("replicate", property prop_replicate) , ("head", property prop_head) , ("tail", property prop_tail) , ("unfoldr", property prop_unfoldr) , ("foldr", property prop_foldr) , ("map", property prop_map) , ("map fusion", property (prop_map_fusion (+1) (+1))) , ("read . show", property prop_show_read) , ("show . read", property prop_read_show) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 , ("IsList", property prop_IsList) #endif ] -------------------------------------------------------------------------------- main :: IO () main = quickCheck $ conjoin $ List.map (uncurry label) props