#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
#endif
module Data.DList (
DList
,fromList
,toList
,apply
,empty
,singleton
,cons
,snoc
,append
,concat
,replicate
,list
,head
,tail
,unfoldr
,foldr
,map
) 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.Monoid
import Data.Function (on)
import Data.String (IsString(..))
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
#ifdef __GLASGOW_HASKELL__
import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
readListPrecDefault)
#if __GLASGOW_HASKELL__ >= 708
import GHC.Exts (IsList)
import qualified GHC.Exts
#endif
#endif
import Control.Applicative(Applicative(..), Alternative, (<|>))
import qualified Control.Applicative (empty)
newtype DList a = DL { unDL :: [a] -> [a] }
fromList :: [a] -> DList a
fromList = DL . (++)
toList :: DList a -> [a]
toList = ($[]) . unDL
apply :: DList a -> [a] -> [a]
apply = unDL
empty :: DList a
empty = DL id
singleton :: a -> DList a
singleton = DL . (:)
infixr `cons`
cons :: a -> DList a -> DList a
cons x xs = DL ((x:) . unDL xs)
infixl `snoc`
snoc :: DList a -> a -> DList a
snoc xs x = DL (unDL xs . (x:))
append :: DList a -> DList a -> DList a
append xs ys = DL (unDL xs . unDL ys)
concat :: [DList a] -> DList a
concat = List.foldr append empty
replicate :: Int -> a -> DList a
replicate n x = DL $ \xs -> let go m | m <= 0 = xs
| otherwise = x : go (m1)
in go n
list :: b -> (a -> DList a -> b) -> DList a -> b
list nill consit dl =
case toList dl of
[] -> nill
(x : xs) -> consit x (fromList xs)
head :: DList a -> a
head = list (error "Data.DList.head: empty dlist") const
tail :: DList a -> DList a
tail = list (error "Data.DList.tail: empty dlist") (flip const)
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 :: (a -> b -> b) -> b -> DList a -> b
foldr f b = List.foldr f b . toList
map :: (a -> b) -> DList a -> DList b
map f = foldr (cons . f) empty
instance Eq a => Eq (DList a) where
(==) = (==) `on` toList
instance Ord a => Ord (DList a) where
compare = compare `on` toList
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
instance Applicative DList where
pure = return
(<*>) = ap
instance Alternative DList where
empty = empty
(<|>) = append
instance Monad DList where
m >>= k
= foldr (append . k) empty m
return x = singleton x
fail _ = empty
instance MonadPlus DList where
mzero = empty
mplus = append
instance Foldable DList where
fold = mconcat . toList
foldMap f = F.foldMap f . toList
foldr f x = List.foldr f x . toList
foldl f x = List.foldl f x . toList
foldr1 f = List.foldr1 f . toList
foldl1 f = List.foldl1 f . toList
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
foldl' f x = List.foldl' f x . toList
foldr' f x = F.foldr' f x . toList
#endif
instance NFData a => NFData (DList a) where
rnf = rnf . toList
instance IsString (DList Char) where
fromString = fromList
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
instance IsList (DList a) where
type Item (DList a) = a
fromList = fromList
toList = toList
#endif