1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
|
-----------------------------------------------------------------------------
-- |
-- Module : Data.DList
-- Copyright : (c) Don Stewart 2006-2007
-- License : BSD-style (see the file LICENSE)
--
-- Maintainer : dons@cse.unsw.edu.au
-- Stability : experimental
-- Portability : portable (Haskell 98)
--
-- Difference lists: a data structure for O(1) append on lists.
--
-----------------------------------------------------------------------------
module Data.DList (
DList(..) -- abstract, instance Monoid, Functor, Applicative, Monad, MonadPlus
-- * Construction
,fromList -- :: [a] -> DList a
,toList -- :: DList a -> [a]
-- * Basic functions
,empty -- :: DList a
,singleton -- :: a -> DList a
,cons -- :: a -> DList a -> DList a
,snoc -- :: DList a -> a -> DList a
,append -- :: DList a -> DList a -> DList a
,concat -- :: [DList a] -> DList a
,replicate -- :: Int -> a -> DList a
,list -- :: b -> (a -> DList a -> b) -> DList a -> b
,head -- :: DList a -> a
,tail -- :: DList a -> DList a
,unfoldr -- :: (b -> Maybe (a, b)) -> b -> DList a
,foldr -- :: (a -> b -> b) -> b -> DList a -> b
,map -- :: (a -> b) -> DList a -> DList b
-- * MonadPlus
, maybeReturn
) where
import Prelude hiding (concat, foldr, map, head, tail, replicate)
import qualified Data.List as List
import Control.Monad
import Data.Monoid
#ifdef APPLICATIVE_IN_BASE
import Control.Applicative(Applicative(..))
#endif
-- | A difference list is a function that given a list, returns the
-- original contents of the difference list prepended at the given list
--
-- This structure supports /O(1)/ append and snoc operations on lists,
-- making it very useful for append-heavy uses, such as logging and
-- pretty printing.
--
-- For example, using DList as the state type when printing a tree with
-- the Writer monad
--
-- > import Control.Monad.Writer
-- > import Data.DList
-- >
-- > data Tree a = Leaf a | Branch (Tree a) (Tree a)
-- >
-- > flatten_writer :: Tree x -> DList x
-- > flatten_writer = snd . runWriter . flatten
-- > where
-- > flatten (Leaf x) = tell (singleton x)
-- > flatten (Branch x y) = flatten x >> flatten y
--
newtype DList a = DL { unDL :: [a] -> [a] }
-- | Converting a normal list to a dlist
fromList :: [a] -> DList a
fromList = DL . (++)
{-# INLINE fromList #-}
-- | Converting a dlist back to a normal list
toList :: DList a -> [a]
toList = ($[]) . unDL
{-# INLINE toList #-}
-- | Create a difference list containing no elements
empty :: DList a
empty = DL id
{-# INLINE empty #-}
-- | Create difference list with given single element
singleton :: a -> DList a
singleton = DL . (:)
{-# INLINE singleton #-}
-- | /O(1)/, Prepend a single element to a difference list
infixr `cons`
cons :: a -> DList a -> DList a
cons x xs = DL ((x:) . unDL xs)
{-# INLINE cons #-}
-- | /O(1)/, Append a single element at a difference list
infixl `snoc`
snoc :: DList a -> a -> DList a
snoc xs x = DL (unDL xs . (x:))
{-# INLINE snoc #-}
-- | /O(1)/, Appending difference lists
append :: DList a -> DList a -> DList a
append xs ys = DL (unDL xs . unDL ys)
{-# INLINE append #-}
-- | /O(spine)/, Concatenate difference lists
concat :: [DList a] -> DList a
concat = List.foldr append empty
{-# INLINE concat #-}
-- | /O(n)/, Create a difference list of the given number of elements
replicate :: Int -> a -> DList a
replicate n x = DL $ \xs -> let go m | m <= 0 = xs
| otherwise = x : go (m-1)
in go n
{-# INLINE replicate #-}
-- | /O(length dl)/, List elimination, head, tail.
list :: b -> (a -> DList a -> b) -> DList a -> b
list nill consit dl =
case toList dl of
[] -> nill
(x : xs) -> consit x (fromList xs)
-- | Return the head of the list
head :: DList a -> a
head = list (error "Data.DList.head: empty list") const
-- | Return the tail of the list
tail :: DList a -> DList a
tail = list (error "Data.DList.tail: empty list") (flip const)
-- | Unfoldr for difference lists
unfoldr :: (b -> Maybe (a, b)) -> b -> DList a
unfoldr pf b =
case pf b of
Nothing -> empty
Just (a, b') -> cons a (unfoldr pf b')
-- | Foldr over difference lists
foldr :: (a -> b -> b) -> b -> DList a -> b
foldr f b = List.foldr f b . toList
{-# INLINE foldr #-}
-- | Map over difference lists.
map :: (a -> b) -> DList a -> DList b
map f = foldr (cons . f) empty
{-# INLINE map #-}
instance Monoid (DList a) where
mempty = empty
mappend = append
instance Functor DList where
fmap = map
{-# INLINE fmap #-}
#ifdef APPLICATIVE_IN_BASE
instance Applicative DList where
pure = return
(<*>) = ap
#endif
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
-- Use this to convert Maybe a into DList a, or indeed into any other MonadPlus instance.
maybeReturn :: MonadPlus m => Maybe a -> m a
maybeReturn = maybe mzero return
|