{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ViewPatterns #-}
#endif
module Data.DList
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 800
( DList(Nil, Cons)
#else
( DList
#endif
, fromList
, toList
, apply
, empty
, singleton
, cons
, snoc
, append
, concat
, replicate
, list
, head
, tail
, unfoldr
, foldr
, map
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 && __GLASGOW_HASKELL__ < 800
, pattern Nil
, pattern Cons
#endif
) where
import Prelude hiding (concat, foldr, map, head, tail, replicate)
import qualified Data.List as List
import Control.DeepSeq (NFData(..))
import Control.Monad as M
import Data.Function (on)
import Data.String (IsString(..))
import qualified Data.Foldable as F
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
import Data.Foldable (Foldable)
import Control.Applicative(Applicative(..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail(..))
#endif
#endif
#ifdef __GLASGOW_HASKELL__
import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,
readListPrecDefault)
#if __GLASGOW_HASKELL__ >= 708
import GHC.Exts (IsList)
import qualified GHC.Exts (IsList(Item, fromList, toList))
#endif
#endif
import Control.Applicative(Alternative, (<|>))
import qualified Control.Applicative (empty)
newtype DList a = DL { DList a -> [a] -> [a]
unDL :: [a] -> [a] }
fromList :: [a] -> DList a
fromList :: [a] -> DList a
fromList = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL (([a] -> [a]) -> DList a) -> ([a] -> [a] -> [a]) -> [a] -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
{-# INLINE fromList #-}
toList :: DList a -> [a]
toList :: DList a -> [a]
toList = (([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$[]) (([a] -> [a]) -> [a]) -> (DList a -> [a] -> [a]) -> DList a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL
{-# INLINE toList #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
#if __GLASGOW_HASKELL__ >= 710
pattern Nil :: DList a
#endif
pattern $mNil :: forall r a. DList a -> (Void# -> r) -> (Void# -> r) -> r
Nil <- (toList -> [])
#if __GLASGOW_HASKELL__ >= 710
pattern Cons :: a -> [a] -> DList a
#endif
pattern $mCons :: forall r a. DList a -> (a -> [a] -> r) -> (Void# -> r) -> r
Cons x xs <- (toList -> x:xs)
#endif
apply :: DList a -> [a] -> [a]
apply :: DList a -> [a] -> [a]
apply = DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL
empty :: DList a
empty :: DList a
empty = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL [a] -> [a]
forall a. a -> a
id
{-# INLINE empty #-}
singleton :: a -> DList a
singleton :: a -> DList a
singleton = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL (([a] -> [a]) -> DList a) -> (a -> [a] -> [a]) -> a -> DList a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:)
{-# INLINE singleton #-}
infixr `cons`
cons :: a -> DList a -> DList a
cons :: a -> DList a -> DList a
cons x :: a
x xs :: DList a
xs = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL DList a
xs)
{-# INLINE cons #-}
infixl `snoc`
snoc :: DList a -> a -> DList a
snoc :: DList a -> a -> DList a
snoc xs :: DList a
xs x :: a
x = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL (DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL DList a
xs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
{-# INLINE snoc #-}
append :: DList a -> DList a -> DList a
append :: DList a -> DList a -> DList a
append xs :: DList a
xs ys :: DList a
ys = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL (DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL DList a
xs ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a] -> [a]
forall a. DList a -> [a] -> [a]
unDL DList a
ys)
{-# INLINE append #-}
concat :: [DList a] -> DList a
concat :: [DList a] -> DList a
concat = (DList a -> DList a -> DList a) -> DList a -> [DList a] -> DList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
append DList a
forall a. DList a
empty
{-# INLINE concat #-}
replicate :: Int -> a -> DList a
replicate :: Int -> a -> DList a
replicate n :: Int
n x :: a
x = ([a] -> [a]) -> DList a
forall a. ([a] -> [a]) -> DList a
DL (([a] -> [a]) -> DList a) -> ([a] -> [a]) -> DList a
forall a b. (a -> b) -> a -> b
$ \xs :: [a]
xs -> let go :: Int -> [a]
go m :: Int
m | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 = [a]
xs
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
in Int -> [a]
go Int
n
{-# INLINE replicate #-}
list :: b -> (a -> DList a -> b) -> DList a -> b
list :: b -> (a -> DList a -> b) -> DList a -> b
list nill :: b
nill consit :: a -> DList a -> b
consit dl :: DList a
dl =
case DList a -> [a]
forall a. DList a -> [a]
toList DList a
dl of
[] -> b
nill
(x :: a
x : xs :: [a]
xs) -> a -> DList a -> b
consit a
x ([a] -> DList a
forall a. [a] -> DList a
fromList [a]
xs)
head :: DList a -> a
head :: DList a -> a
head = a -> (a -> DList a -> a) -> DList a -> a
forall b a. b -> (a -> DList a -> b) -> DList a -> b
list ([Char] -> a
forall a. HasCallStack => [Char] -> a
error "Data.DList.head: empty dlist") a -> DList a -> a
forall a b. a -> b -> a
const
tail :: DList a -> DList a
tail :: DList a -> DList a
tail = DList a -> (a -> DList a -> DList a) -> DList a -> DList a
forall b a. b -> (a -> DList a -> b) -> DList a -> b
list ([Char] -> DList a
forall a. HasCallStack => [Char] -> a
error "Data.DList.tail: empty dlist") ((DList a -> a -> DList a) -> a -> DList a -> DList a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DList a -> a -> DList a
forall a b. a -> b -> a
const)
unfoldr :: (b -> Maybe (a, b)) -> b -> DList a
unfoldr :: (b -> Maybe (a, b)) -> b -> DList a
unfoldr pf :: b -> Maybe (a, b)
pf b :: b
b =
case b -> Maybe (a, b)
pf b
b of
Nothing -> DList a
forall a. DList a
empty
Just (a :: a
a, b' :: b
b') -> a -> DList a -> DList a
forall a. a -> DList a -> DList a
cons a
a ((b -> Maybe (a, b)) -> b -> DList a
forall b a. (b -> Maybe (a, b)) -> b -> DList a
unfoldr b -> Maybe (a, b)
pf b
b')
foldr :: (a -> b -> b) -> b -> DList a -> b
foldr :: (a -> b -> b) -> b -> DList a -> b
foldr f :: a -> b -> b
f b :: b
b = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr a -> b -> b
f b
b ([a] -> b) -> (DList a -> [a]) -> DList a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldr #-}
map :: (a -> b) -> DList a -> DList b
map :: (a -> b) -> DList a -> DList b
map f :: a -> b
f = (a -> DList b -> DList b) -> DList b -> DList a -> DList b
forall a b. (a -> b -> b) -> b -> DList a -> b
foldr (b -> DList b -> DList b
forall a. a -> DList a -> DList a
cons (b -> DList b -> DList b) -> (a -> b) -> a -> DList b -> DList b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) DList b
forall a. DList a
empty
{-# INLINE map #-}
instance Eq a => Eq (DList a) where
== :: DList a -> DList a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool)
-> (DList a -> [a]) -> DList a -> DList a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DList a -> [a]
forall a. DList a -> [a]
toList
instance Ord a => Ord (DList a) where
compare :: DList a -> DList a -> Ordering
compare = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([a] -> [a] -> Ordering)
-> (DList a -> [a]) -> DList a -> DList a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` DList a -> [a]
forall a. DList a -> [a]
toList
instance Read a => Read (DList a) where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec (DList a)
readPrec = ReadPrec (DList a) -> ReadPrec (DList a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (DList a) -> ReadPrec (DList a))
-> ReadPrec (DList a) -> ReadPrec (DList a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (DList a) -> ReadPrec (DList a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec (DList a) -> ReadPrec (DList a))
-> ReadPrec (DList a) -> ReadPrec (DList a)
forall a b. (a -> b) -> a -> b
$ do
Ident "fromList" <- ReadPrec Lexeme
lexP
[a]
dl <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
DList a -> ReadPrec (DList a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> DList a
forall a. [a] -> DList a
fromList [a]
dl)
readListPrec :: ReadPrec [DList a]
readListPrec = ReadPrec [DList a]
forall a. Read a => ReadPrec [a]
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 :: Int -> DList a -> ShowS
showsPrec p :: Int
p dl :: DList a
dl = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString "fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (DList a -> [a]
forall a. DList a -> [a]
toList DList a
dl)
instance Monoid (DList a) where
mempty :: DList a
mempty = DList a
forall a. DList a
empty
mappend :: DList a -> DList a -> DList a
mappend = DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
append
instance Functor DList where
fmap :: (a -> b) -> DList a -> DList b
fmap = (a -> b) -> DList a -> DList b
forall a b. (a -> b) -> DList a -> DList b
map
{-# INLINE fmap #-}
instance Applicative DList where
pure :: a -> DList a
pure = a -> DList a
forall a. a -> DList a
singleton
{-# INLINE pure #-}
<*> :: DList (a -> b) -> DList a -> DList b
(<*>) = DList (a -> b) -> DList a -> DList b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Alternative DList where
empty :: DList a
empty = DList a
forall a. DList a
empty
<|> :: DList a -> DList a -> DList a
(<|>) = DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
append
instance Monad DList where
m :: DList a
m >>= :: DList a -> (a -> DList b) -> DList b
>>= k :: a -> DList b
k
= (a -> DList b -> DList b) -> DList b -> DList a -> DList b
forall a b. (a -> b -> b) -> b -> DList a -> b
foldr (DList b -> DList b -> DList b
forall a. DList a -> DList a -> DList a
append (DList b -> DList b -> DList b)
-> (a -> DList b) -> a -> DList b -> DList b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DList b
k) DList b
forall a. DList a
empty DList a
m
{-# INLINE (>>=) #-}
return :: a -> DList a
return = a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
#if !MIN_VERSION_base(4,13,0)
fail _ = empty
{-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance MonadFail DList where
fail :: [Char] -> DList a
fail _ = DList a
forall a. DList a
empty
{-# INLINE fail #-}
#endif
instance MonadPlus DList where
mzero :: DList a
mzero = DList a
forall a. DList a
empty
mplus :: DList a -> DList a -> DList a
mplus = DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
append
instance Foldable DList where
fold :: DList m -> m
fold = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> m) -> (DList m -> [m]) -> DList m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList m -> [m]
forall a. DList a -> [a]
toList
{-# INLINE fold #-}
foldMap :: (a -> m) -> DList a -> m
foldMap f :: a -> m
f = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f ([a] -> m) -> (DList a -> [a]) -> DList a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldMap #-}
foldr :: (a -> b -> b) -> b -> DList a -> b
foldr f :: a -> b -> b
f x :: b
x = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr a -> b -> b
f b
x ([a] -> b) -> (DList a -> [a]) -> DList a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldr #-}
foldl :: (b -> a -> b) -> b -> DList a -> b
foldl f :: b -> a -> b
f x :: b
x = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl b -> a -> b
f b
x ([a] -> b) -> (DList a -> [a]) -> DList a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldl #-}
foldr1 :: (a -> a -> a) -> DList a -> a
foldr1 f :: a -> a -> a
f = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
List.foldr1 a -> a -> a
f ([a] -> a) -> (DList a -> [a]) -> DList a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldr1 #-}
foldl1 :: (a -> a -> a) -> DList a -> a
foldl1 f :: a -> a -> a
f = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
List.foldl1 a -> a -> a
f ([a] -> a) -> (DList a -> [a]) -> DList a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldl1 #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
foldl' :: (b -> a -> b) -> b -> DList a -> b
foldl' f :: b -> a -> b
f x :: b
x = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' b -> a -> b
f b
x ([a] -> b) -> (DList a -> [a]) -> DList a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldl' #-}
foldr' :: (a -> b -> b) -> b -> DList a -> b
foldr' f :: a -> b -> b
f x :: b
x = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr' a -> b -> b
f b
x ([a] -> b) -> (DList a -> [a]) -> DList a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE foldr' #-}
#endif
instance NFData a => NFData (DList a) where
rnf :: DList a -> ()
rnf = [a] -> ()
forall a. NFData a => a -> ()
rnf ([a] -> ()) -> (DList a -> [a]) -> DList a -> ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList a -> [a]
forall a. DList a -> [a]
toList
{-# INLINE rnf #-}
instance a ~ Char => IsString (DList a) where
fromString :: [Char] -> DList a
fromString = [Char] -> DList a
forall a. [a] -> DList a
fromList
{-# INLINE fromString #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708
instance IsList (DList a) where
type Item (DList a) = a
fromList :: [Item (DList a)] -> DList a
fromList = [Item (DList a)] -> DList a
forall a. [a] -> DList a
fromList
{-# INLINE fromList #-}
toList :: DList a -> [Item (DList a)]
toList = DList a -> [Item (DList a)]
forall a. DList a -> [a]
toList
{-# INLINE toList #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance Semigroup (DList a) where
<> :: DList a -> DList a -> DList a
(<>) = DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
append
{-# INLINE (<>) #-}
stimes :: b -> DList a -> DList a
stimes n :: b
n x :: DList a
x
| b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = [Char] -> DList a
forall a. HasCallStack => [Char] -> a
error "Data.DList.stimes: negative multiplier"
| Bool
otherwise = b -> DList a
rep b
n
where
rep :: b -> DList a
rep 0 = DList a
forall a. DList a
empty
rep i :: b
i = DList a
x DList a -> DList a -> DList a
forall a. Semigroup a => a -> a -> a
<> b -> DList a
rep (b -> b
forall a. Enum a => a -> a
pred b
i)
#endif