{-# LANGUAGE CPP, TypeFamilies #-}
module Data.SortedList (
SortedList
, toSortedList
, fromSortedList
, singleton
, repeat
, replicate
, iterate
, uncons
, insert
, delete
, deleteAll
, take
, drop
, splitAt
, takeWhile
, dropWhile
, span
, partition
, filter
, filterLT
, filterGT
, filterLE
, filterGE
#if !MIN_VERSION_base(4,8,0)
, null
#endif
, elemOrd
, findIndices
, map
, mapDec
, unfoldr
#if MIN_VERSION_base(4,6,0)
, reverse, reverseDown
#endif
, nub
, intersect
, union
) where
import Prelude hiding
( take, drop, splitAt, filter
, repeat, replicate, iterate
, null, map, reverse
, span, takeWhile, dropWhile
#if !MIN_VERSION_base(4,8,0)
, foldr, foldl
#endif
)
import qualified Data.List as List
import Control.DeepSeq (NFData (..))
import Data.Foldable (Foldable (..))
#if MIN_VERSION_base(4,5,0) && !MIN_VERSION_base(4,9,0)
import Data.Monoid ((<>))
#endif
#if MIN_VERSION_base(4,6,0)
import Data.Ord (Down (..))
#endif
#if MIN_VERSION_base(4,7,0)
import qualified GHC.Exts as Exts
#endif
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid (..))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup (..))
#endif
newtype SortedList a = SortedList [a] deriving (SortedList a -> SortedList a -> Bool
forall a. Eq a => SortedList a -> SortedList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortedList a -> SortedList a -> Bool
$c/= :: forall a. Eq a => SortedList a -> SortedList a -> Bool
== :: SortedList a -> SortedList a -> Bool
$c== :: forall a. Eq a => SortedList a -> SortedList a -> Bool
Eq, SortedList a -> SortedList a -> Bool
SortedList a -> SortedList a -> Ordering
SortedList a -> SortedList a -> SortedList a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (SortedList a)
forall a. Ord a => SortedList a -> SortedList a -> Bool
forall a. Ord a => SortedList a -> SortedList a -> Ordering
forall a. Ord a => SortedList a -> SortedList a -> SortedList a
min :: SortedList a -> SortedList a -> SortedList a
$cmin :: forall a. Ord a => SortedList a -> SortedList a -> SortedList a
max :: SortedList a -> SortedList a -> SortedList a
$cmax :: forall a. Ord a => SortedList a -> SortedList a -> SortedList a
>= :: SortedList a -> SortedList a -> Bool
$c>= :: forall a. Ord a => SortedList a -> SortedList a -> Bool
> :: SortedList a -> SortedList a -> Bool
$c> :: forall a. Ord a => SortedList a -> SortedList a -> Bool
<= :: SortedList a -> SortedList a -> Bool
$c<= :: forall a. Ord a => SortedList a -> SortedList a -> Bool
< :: SortedList a -> SortedList a -> Bool
$c< :: forall a. Ord a => SortedList a -> SortedList a -> Bool
compare :: SortedList a -> SortedList a -> Ordering
$ccompare :: forall a. Ord a => SortedList a -> SortedList a -> Ordering
Ord)
instance Show a => Show (SortedList a) where
show :: SortedList a -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SortedList a -> [a]
fromSortedList
instance NFData a => NFData (SortedList a) where
{-# INLINE rnf #-}
rnf :: SortedList a -> ()
rnf (SortedList [a]
xs) = forall a. NFData a => a -> ()
rnf [a]
xs
#if MIN_VERSION_base(4,7,0)
instance Ord a => Exts.IsList (SortedList a) where
type (Item (SortedList a)) = a
fromList :: [Item (SortedList a)] -> SortedList a
fromList = forall a. Ord a => [a] -> SortedList a
toSortedList
toList :: SortedList a -> [Item (SortedList a)]
toList = forall a. SortedList a -> [a]
fromSortedList
#endif
#if !MIN_VERSION_base(4,8,0)
null :: SortedList a -> Bool
null = List.null . fromSortedList
#endif
uncons :: SortedList a -> Maybe (a, SortedList a)
uncons :: forall a. SortedList a -> Maybe (a, SortedList a)
uncons (SortedList []) = forall a. Maybe a
Nothing
uncons (SortedList (a
x:[a]
xs)) = forall a. a -> Maybe a
Just (a
x, forall a. [a] -> SortedList a
SortedList [a]
xs)
toSortedList :: Ord a => [a] -> SortedList a
toSortedList :: forall a. Ord a => [a] -> SortedList a
toSortedList = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
List.sort
fromSortedList :: SortedList a -> [a]
fromSortedList :: forall a. SortedList a -> [a]
fromSortedList (SortedList [a]
xs) = [a]
xs
mergeSortedLists :: Ord a => [a] -> [a] -> [a]
mergeSortedLists :: forall a. Ord a => [a] -> [a] -> [a]
mergeSortedLists [a]
xs [] = [a]
xs
mergeSortedLists [] [a]
ys = [a]
ys
mergeSortedLists (a
x:[a]
xs) (a
y:[a]
ys) =
if a
x forall a. Ord a => a -> a -> Bool
<= a
y
then a
x forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSortedLists [a]
xs (a
yforall a. a -> [a] -> [a]
:[a]
ys)
else a
y forall a. a -> [a] -> [a]
: forall a. Ord a => [a] -> [a] -> [a]
mergeSortedLists (a
xforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
#if MIN_VERSION_base(4,9,0)
instance Ord a => Semigroup (SortedList a) where
SortedList [a]
xs <> :: SortedList a -> SortedList a -> SortedList a
<> SortedList [a]
ys = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a] -> [a]
mergeSortedLists [a]
xs [a]
ys
instance Ord a => Monoid (SortedList a) where
mempty :: SortedList a
mempty = forall a. [a] -> SortedList a
SortedList []
mappend :: SortedList a -> SortedList a -> SortedList a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
#else
instance Ord a => Monoid (SortedList a) where
mempty = SortedList []
mappend (SortedList xs) (SortedList ys) = SortedList $ mergeSortedLists xs ys
#endif
singleton :: a -> SortedList a
singleton :: forall a. a -> SortedList a
singleton a
x = forall a. [a] -> SortedList a
SortedList [a
x]
repeat :: a -> SortedList a
repeat :: forall a. a -> SortedList a
repeat = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
List.repeat
replicate :: Int -> a -> SortedList a
replicate :: forall a. Int -> a -> SortedList a
replicate Int
n = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
List.replicate Int
n
unfoldr :: Ord a => (b -> Maybe (a,b)) -> b -> SortedList a
unfoldr :: forall a b. Ord a => (b -> Maybe (a, b)) -> b -> SortedList a
unfoldr b -> Maybe (a, b)
f b
e = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$
let g :: (a, b) -> Maybe (a, (a, b))
g (a
prev,b
acc) = do
(a
curr,b
acc') <- b -> Maybe (a, b)
f b
acc
if a
prev forall a. Ord a => a -> a -> Bool
<= a
curr
then forall a. a -> Maybe a
Just (a
curr, (a
curr, b
acc'))
else forall a. Maybe a
Nothing
in case b -> Maybe (a, b)
f b
e of
Just (a
x0,b
e') -> a
x0 forall a. a -> [a] -> [a]
: forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (a, b) -> Maybe (a, (a, b))
g (a
x0,b
e')
Maybe (a, b)
_ -> []
iterate :: Ord a => (a -> a) -> a -> SortedList a
iterate :: forall a. Ord a => (a -> a) -> a -> SortedList a
iterate a -> a
f = forall a b. Ord a => (b -> Maybe (a, b)) -> b -> SortedList a
unfoldr forall a b. (a -> b) -> a -> b
$ \a
x -> forall a. a -> Maybe a
Just (a
x, a -> a
f a
x)
insert :: Ord a => a -> SortedList a -> SortedList a
#if MIN_VERSION_base(4,5,0)
insert :: forall a. Ord a => a -> SortedList a -> SortedList a
insert a
x SortedList a
xs = forall a. a -> SortedList a
singleton a
x forall a. Semigroup a => a -> a -> a
<> SortedList a
xs
#else
insert x xs = mappend (singleton x) xs
#endif
delete :: Ord a => a -> SortedList a -> SortedList a
{-# INLINE delete #-}
delete :: forall a. Ord a => a -> SortedList a -> SortedList a
delete a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) =
case a
x forall a. Ord a => a -> a -> Ordering
`compare` a
a of
Ordering
LT -> a
x forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs
Ordering
GT -> a
x forall a. a -> [a] -> [a]
: [a]
xs
Ordering
EQ -> [a]
xs
go [] = []
deleteAll :: Ord a => a -> SortedList a -> SortedList a
deleteAll :: forall a. Ord a => a -> SortedList a -> SortedList a
deleteAll a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) =
case a
x forall a. Ord a => a -> a -> Ordering
`compare` a
a of
Ordering
LT -> a
x forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs
Ordering
GT -> a
x forall a. a -> [a] -> [a]
: [a]
xs
Ordering
EQ -> [a] -> [a]
go [a]
xs
go [] = []
take :: Int -> SortedList a -> SortedList a
take :: forall a. Int -> SortedList a -> SortedList a
take Int
n = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> SortedList a -> (SortedList a, SortedList a)
splitAt Int
n
drop :: Int -> SortedList a -> SortedList a
drop :: forall a. Int -> SortedList a -> SortedList a
drop Int
n = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> SortedList a -> (SortedList a, SortedList a)
splitAt Int
n
splitAt :: Int -> SortedList a -> (SortedList a, SortedList a)
splitAt :: forall a. Int -> SortedList a -> (SortedList a, SortedList a)
splitAt Int
n (SortedList [a]
xs) =
let ([a]
ys,[a]
zs) = forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
n [a]
xs
in (forall a. [a] -> SortedList a
SortedList [a]
ys, forall a. [a] -> SortedList a
SortedList [a]
zs)
partition :: (a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
partition :: forall a.
(a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
partition a -> Bool
f (SortedList [a]
xs) =
let ([a]
ys,[a]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition a -> Bool
f [a]
xs
in (forall a. [a] -> SortedList a
SortedList [a]
ys, forall a. [a] -> SortedList a
SortedList [a]
zs)
filter :: (a -> Bool) -> SortedList a -> SortedList a
filter :: forall a. (a -> Bool) -> SortedList a -> SortedList a
filter a -> Bool
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
partition a -> Bool
f
filterLT :: Ord a => a -> SortedList a -> SortedList a
filterLT :: forall a. Ord a => a -> SortedList a -> SortedList a
filterLT a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) = if a
x forall a. Ord a => a -> a -> Bool
< a
a then a
x forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs else []
go [] = []
filterGT :: Ord a => a -> SortedList a -> SortedList a
filterGT :: forall a. Ord a => a -> SortedList a -> SortedList a
filterGT a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) = if a
a forall a. Ord a => a -> a -> Bool
< a
x then a
x forall a. a -> [a] -> [a]
: [a]
xs else [a] -> [a]
go [a]
xs
go [] = []
filterLE :: Ord a => a -> SortedList a -> SortedList a
filterLE :: forall a. Ord a => a -> SortedList a -> SortedList a
filterLE a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) = if a
x forall a. Ord a => a -> a -> Bool
<= a
a then a
x forall a. a -> [a] -> [a]
: [a] -> [a]
go [a]
xs else []
go [] = []
filterGE :: Ord a => a -> SortedList a -> SortedList a
filterGE :: forall a. Ord a => a -> SortedList a -> SortedList a
filterGE a
a (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:[a]
xs) = if a
a forall a. Ord a => a -> a -> Bool
<= a
x then a
x forall a. a -> [a] -> [a]
: [a]
xs else [a] -> [a]
go [a]
xs
go [] = []
elemOrd :: Ord a => a -> SortedList a -> Bool
elemOrd :: forall a. Ord a => a -> SortedList a -> Bool
elemOrd a
a (SortedList [a]
l) = [a] -> Bool
go [a]
l
where
go :: [a] -> Bool
go (a
x:[a]
xs) =
case forall a. Ord a => a -> a -> Ordering
compare a
a a
x of
Ordering
GT -> [a] -> Bool
go [a]
xs
Ordering
EQ -> Bool
True
Ordering
_ -> Bool
False
go [a]
_ = Bool
False
nub :: Eq a => SortedList a -> SortedList a
nub :: forall a. Eq a => SortedList a -> SortedList a
nub (SortedList [a]
l) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ forall {a}. Eq a => [a] -> [a]
go [a]
l
where
go :: [a] -> [a]
go (a
x:a
y:[a]
xs) = if a
x forall a. Eq a => a -> a -> Bool
== a
y then [a] -> [a]
go (a
xforall a. a -> [a] -> [a]
:[a]
xs) else a
x forall a. a -> [a] -> [a]
: [a] -> [a]
go (a
yforall a. a -> [a] -> [a]
:[a]
xs)
go [a]
xs = [a]
xs
instance Foldable SortedList where
{-# INLINE foldr #-}
foldr :: forall a b. (a -> b -> b) -> b -> SortedList a -> b
foldr a -> b -> b
f b
e (SortedList [a]
xs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
e [a]
xs
#if MIN_VERSION_base(4,8,0)
{-# INLINE toList #-}
toList :: forall a. SortedList a -> [a]
toList = forall a. SortedList a -> [a]
fromSortedList
minimum :: forall a. Ord a => SortedList a -> a
minimum (SortedList [a]
xs) =
case [a]
xs of
a
x : [a]
_ -> a
x
[a]
_ -> forall a. HasCallStack => String -> a
error String
"SortedList.minimum: empty list"
maximum :: forall a. Ord a => SortedList a -> a
maximum (SortedList [a]
xs) =
case [a]
xs of
[] -> forall a. HasCallStack => String -> a
error String
"SortedList.maximum: empty list"
[a]
_ -> forall a. [a] -> a
last [a]
xs
#endif
map :: Ord b => (a -> b) -> SortedList a -> SortedList b
{-# INLINE[1] map #-}
map :: forall b a. Ord b => (a -> b) -> SortedList a -> SortedList b
map a -> b
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Ord a => a -> SortedList a -> SortedList a
insert forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a. Monoid a => a
mempty
mapDec :: Ord b => (a -> b) -> SortedList a -> SortedList b
{-# INLINE[1] mapDec #-}
mapDec :: forall b a. Ord b => (a -> b) -> SortedList a -> SortedList b
mapDec a -> b
f = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SortedList b
xs a
x -> forall a. Ord a => a -> SortedList a -> SortedList a
insert (a -> b
f a
x) SortedList b
xs) forall a. Monoid a => a
mempty
{-# RULES
"SortedList:map/map" forall f g xs. map f (map g xs) = map (f . g) xs
"SortedList:map/id" forall xs. map id xs = xs
"SortedList:mapDec/mapDec" forall f g xs. mapDec f (map g xs) = mapDec (f . g) xs
"SortedList:mapDec/map" forall f g xs. mapDec f (map g xs) = map (f . g) xs
"SortedList:map/mapDec" forall f g xs. map f (mapDec g xs) = map (f . g) xs
"SortedList:mapDec/id" forall xs. mapDec id xs = xs
#-}
#if MIN_VERSION_base(4,6,0)
reverse :: SortedList a -> SortedList (Down a)
{-# INLINE[2] reverse #-}
reverse :: forall a. SortedList a -> SortedList (Down a)
reverse = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
List.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SortedList a -> [a]
fromSortedList
{-# RULES
"SortedList:map/Down" forall xs. map Down xs = reverse xs
#-}
reverseDown :: SortedList (Down a) -> SortedList a
{-# INLINE[2] reverseDown #-}
reverseDown :: forall a. SortedList (Down a) -> SortedList a
reverseDown = forall a. [a] -> SortedList a
SortedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
List.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Down a -> a
unDown forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SortedList a -> [a]
fromSortedList
where
unDown :: Down a -> a
unDown (Down a
a) = a
a
#endif
span :: (a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
span :: forall a.
(a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
span a -> Bool
f (SortedList [a]
xs) =
let ([a]
ys,[a]
zs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span a -> Bool
f [a]
xs
in (forall a. [a] -> SortedList a
SortedList [a]
ys, forall a. [a] -> SortedList a
SortedList [a]
zs)
takeWhile :: (a -> Bool) -> SortedList a -> SortedList a
takeWhile :: forall a. (a -> Bool) -> SortedList a -> SortedList a
takeWhile a -> Bool
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
span a -> Bool
f
dropWhile :: (a -> Bool) -> SortedList a -> SortedList a
dropWhile :: forall a. (a -> Bool) -> SortedList a -> SortedList a
dropWhile a -> Bool
f = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(a -> Bool) -> SortedList a -> (SortedList a, SortedList a)
span a -> Bool
f
findIndices :: (a -> Bool) -> SortedList a -> SortedList Int
findIndices :: forall a. (a -> Bool) -> SortedList a -> SortedList Int
findIndices a -> Bool
f (SortedList [a]
xs) = forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [Int]
List.findIndices a -> Bool
f [a]
xs
intersect :: Ord a => SortedList a -> SortedList a -> SortedList a
intersect :: forall a. Ord a => SortedList a -> SortedList a -> SortedList a
intersect SortedList a
xs SortedList a
ys =
let SortedList [a]
xs' = SortedList a
xs
SortedList [a]
ys' = forall a. Eq a => SortedList a -> SortedList a
nub SortedList a
ys
go :: [a] -> [a] -> [a]
go [] [a]
_ = []
go [a]
_ [] = []
go pp :: [a]
pp@(a
p:[a]
ps) qq :: [a]
qq@(a
q:[a]
qs) =
case a
p forall a. Ord a => a -> a -> Ordering
`compare` a
q of
Ordering
LT -> [a] -> [a] -> [a]
go [a]
ps [a]
qq
Ordering
EQ -> a
p forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
go [a]
ps [a]
qq
Ordering
GT -> [a] -> [a] -> [a]
go [a]
pp [a]
qs
in forall a. [a] -> SortedList a
SortedList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a] -> [a]
go [a]
xs' [a]
ys'
union :: Ord a => SortedList a -> SortedList a -> SortedList a
union :: forall a. Ord a => SortedList a -> SortedList a -> SortedList a
union SortedList a
xs SortedList a
ys = SortedList a
xs forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> SortedList a -> SortedList a
delete) (forall a. Eq a => SortedList a -> SortedList a
nub SortedList a
ys) SortedList a
xs