{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE BangPatterns #-}
module OrdList (
OrdList,
nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL,
headOL,
mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse,
strictlyEqOL, strictlyOrdOL
) where
import GhcPrelude
import Data.Foldable
import Outputable
import qualified Data.Semigroup as Semigroup
infixl 5 `appOL`
infixl 5 `snocOL`
infixr 5 `consOL`
data OrdList a
= None
| One a
| Many [a]
| Cons a (OrdList a)
| Snoc (OrdList a) a
| Two (OrdList a)
(OrdList a)
deriving (a -> OrdList b -> OrdList a
(a -> b) -> OrdList a -> OrdList b
(forall a b. (a -> b) -> OrdList a -> OrdList b)
-> (forall a b. a -> OrdList b -> OrdList a) -> Functor OrdList
forall a b. a -> OrdList b -> OrdList a
forall a b. (a -> b) -> OrdList a -> OrdList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> OrdList b -> OrdList a
$c<$ :: forall a b. a -> OrdList b -> OrdList a
fmap :: (a -> b) -> OrdList a -> OrdList b
$cfmap :: forall a b. (a -> b) -> OrdList a -> OrdList b
Functor)
instance Outputable a => Outputable (OrdList a) where
ppr :: OrdList a -> SDoc
ppr ol :: OrdList a
ol = [a] -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL OrdList a
ol)
instance Semigroup (OrdList a) where
<> :: OrdList a -> OrdList a -> OrdList a
(<>) = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
appOL
instance Monoid (OrdList a) where
mempty :: OrdList a
mempty = OrdList a
forall a. OrdList a
nilOL
mappend :: OrdList a -> OrdList a -> OrdList a
mappend = OrdList a -> OrdList a -> OrdList a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)
mconcat :: [OrdList a] -> OrdList a
mconcat = [OrdList a] -> OrdList a
forall a. [OrdList a] -> OrdList a
concatOL
instance Foldable OrdList where
foldr :: (a -> b -> b) -> b -> OrdList a -> b
foldr = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL
foldl' :: (b -> a -> b) -> b -> OrdList a -> b
foldl' = (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL
toList :: OrdList a -> [a]
toList = OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL
null :: OrdList a -> Bool
null = OrdList a -> Bool
forall a. OrdList a -> Bool
isNilOL
length :: OrdList a -> Int
length = OrdList a -> Int
forall a. OrdList a -> Int
lengthOL
instance Traversable OrdList where
traverse :: (a -> f b) -> OrdList a -> f (OrdList b)
traverse f :: a -> f b
f xs :: OrdList a
xs = [b] -> OrdList b
forall a. [a] -> OrdList a
toOL ([b] -> OrdList b) -> f [b] -> f (OrdList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (OrdList a -> [a]
forall a. OrdList a -> [a]
fromOL OrdList a
xs)
nilOL :: OrdList a
isNilOL :: OrdList a -> Bool
unitOL :: a -> OrdList a
snocOL :: OrdList a -> a -> OrdList a
consOL :: a -> OrdList a -> OrdList a
appOL :: OrdList a -> OrdList a -> OrdList a
concatOL :: [OrdList a] -> OrdList a
headOL :: OrdList a -> a
lastOL :: OrdList a -> a
lengthOL :: OrdList a -> Int
nilOL :: OrdList a
nilOL = OrdList a
forall a. OrdList a
None
unitOL :: a -> OrdList a
unitOL as :: a
as = a -> OrdList a
forall a. a -> OrdList a
One a
as
snocOL :: OrdList a -> a -> OrdList a
snocOL as :: OrdList a
as b :: a
b = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
as a
b
consOL :: a -> OrdList a -> OrdList a
consOL a :: a
a bs :: OrdList a
bs = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
bs
concatOL :: [OrdList a] -> OrdList a
concatOL aas :: [OrdList a]
aas = (OrdList a -> OrdList a -> OrdList a)
-> OrdList a -> [OrdList a] -> OrdList a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
appOL OrdList a
forall a. OrdList a
None [OrdList a]
aas
headOL :: OrdList a -> a
headOL None = String -> a
forall a. String -> a
panic "headOL"
headOL (One a :: a
a) = a
a
headOL (Many as :: [a]
as) = [a] -> a
forall a. [a] -> a
head [a]
as
headOL (Cons a :: a
a _) = a
a
headOL (Snoc as :: OrdList a
as _) = OrdList a -> a
forall a. OrdList a -> a
headOL OrdList a
as
headOL (Two as :: OrdList a
as _) = OrdList a -> a
forall a. OrdList a -> a
headOL OrdList a
as
lastOL :: OrdList a -> a
lastOL None = String -> a
forall a. String -> a
panic "lastOL"
lastOL (One a :: a
a) = a
a
lastOL (Many as :: [a]
as) = [a] -> a
forall a. [a] -> a
last [a]
as
lastOL (Cons _ as :: OrdList a
as) = OrdList a -> a
forall a. OrdList a -> a
lastOL OrdList a
as
lastOL (Snoc _ a :: a
a) = a
a
lastOL (Two _ as :: OrdList a
as) = OrdList a -> a
forall a. OrdList a -> a
lastOL OrdList a
as
lengthOL :: OrdList a -> Int
lengthOL None = 0
lengthOL (One _) = 1
lengthOL (Many as :: [a]
as) = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
lengthOL (Cons _ as :: OrdList a
as) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as
lengthOL (Snoc as :: OrdList a
as _) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as
lengthOL (Two as :: OrdList a
as bs :: OrdList a
bs) = OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ OrdList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length OrdList a
bs
isNilOL :: OrdList a -> Bool
isNilOL None = Bool
True
isNilOL _ = Bool
False
None appOL :: OrdList a -> OrdList a -> OrdList a
`appOL` b :: OrdList a
b = OrdList a
b
a :: OrdList a
a `appOL` None = OrdList a
a
One a :: a
a `appOL` b :: OrdList a
b = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
a OrdList a
b
a :: OrdList a
a `appOL` One b :: a
b = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc OrdList a
a a
b
a :: OrdList a
a `appOL` b :: OrdList a
b = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
Two OrdList a
a OrdList a
b
fromOL :: OrdList a -> [a]
fromOL :: OrdList a -> [a]
fromOL a :: OrdList a
a = OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
a []
where go :: OrdList a -> [a] -> [a]
go None acc :: [a]
acc = [a]
acc
go (One a :: a
a) acc :: [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
go (Cons a :: a
a b :: OrdList a
b) acc :: [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc
go (Snoc a :: OrdList a
a b :: a
b) acc :: [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (a
ba -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc)
go (Two a :: OrdList a
a b :: OrdList a
b) acc :: [a]
acc = OrdList a -> [a] -> [a]
go OrdList a
a (OrdList a -> [a] -> [a]
go OrdList a
b [a]
acc)
go (Many xs :: [a]
xs) acc :: [a]
acc = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc
fromOLReverse :: OrdList a -> [a]
fromOLReverse :: OrdList a -> [a]
fromOLReverse a :: OrdList a
a = OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
a []
where go :: OrdList a -> [a] -> [a]
go :: OrdList a -> [a] -> [a]
go None acc :: [a]
acc = [a]
acc
go (One a :: a
a) acc :: [a]
acc = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
go (Cons a :: a
a b :: OrdList a
b) acc :: [a]
acc = OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
b (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
go (Snoc a :: OrdList a
a b :: a
b) acc :: [a]
acc = a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
a [a]
acc
go (Two a :: OrdList a
a b :: OrdList a
b) acc :: [a]
acc = OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
b (OrdList a -> [a] -> [a]
forall a. OrdList a -> [a] -> [a]
go OrdList a
a [a]
acc)
go (Many xs :: [a]
xs) acc :: [a]
acc = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
acc
mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL :: (a -> b) -> OrdList a -> OrdList b
mapOL = (a -> b) -> OrdList a -> OrdList b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
foldrOL :: (a->b->b) -> b -> OrdList a -> b
foldrOL :: (a -> b -> b) -> b -> OrdList a -> b
foldrOL _ z :: b
z None = b
z
foldrOL k :: a -> b -> b
k z :: b
z (One x :: a
x) = a -> b -> b
k a
x b
z
foldrOL k :: a -> b -> b
k z :: b
z (Cons x :: a
x xs :: OrdList a
xs) = a -> b -> b
k a
x ((a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k b
z OrdList a
xs)
foldrOL k :: a -> b -> b
k z :: b
z (Snoc xs :: OrdList a
xs x :: a
x) = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k (a -> b -> b
k a
x b
z) OrdList a
xs
foldrOL k :: a -> b -> b
k z :: b
z (Two b1 :: OrdList a
b1 b2 :: OrdList a
b2) = (a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k ((a -> b -> b) -> b -> OrdList a -> b
forall a b. (a -> b -> b) -> b -> OrdList a -> b
foldrOL a -> b -> b
k b
z OrdList a
b2) OrdList a
b1
foldrOL k :: a -> b -> b
k z :: b
z (Many xs :: [a]
xs) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z [a]
xs
foldlOL :: (b->a->b) -> b -> OrdList a -> b
foldlOL :: (b -> a -> b) -> b -> OrdList a -> b
foldlOL _ z :: b
z None = b
z
foldlOL k :: b -> a -> b
k z :: b
z (One x :: a
x) = b -> a -> b
k b
z a
x
foldlOL k :: b -> a -> b
k z :: b
z (Cons x :: a
x xs :: OrdList a
xs) = let !z' :: b
z' = (b -> a -> b
k b
z a
x) in (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z' OrdList a
xs
foldlOL k :: b -> a -> b
k z :: b
z (Snoc xs :: OrdList a
xs x :: a
x) = let !z' :: b
z' = ((b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z OrdList a
xs) in b -> a -> b
k b
z' a
x
foldlOL k :: b -> a -> b
k z :: b
z (Two b1 :: OrdList a
b1 b2 :: OrdList a
b2) = let !z' :: b
z' = ((b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z OrdList a
b1) in (b -> a -> b) -> b -> OrdList a -> b
forall b a. (b -> a -> b) -> b -> OrdList a -> b
foldlOL b -> a -> b
k b
z' OrdList a
b2
foldlOL k :: b -> a -> b
k z :: b
z (Many xs :: [a]
xs) = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' b -> a -> b
k b
z [a]
xs
toOL :: [a] -> OrdList a
toOL :: [a] -> OrdList a
toOL [] = OrdList a
forall a. OrdList a
None
toOL [x :: a
x] = a -> OrdList a
forall a. a -> OrdList a
One a
x
toOL xs :: [a]
xs = [a] -> OrdList a
forall a. [a] -> OrdList a
Many [a]
xs
reverseOL :: OrdList a -> OrdList a
reverseOL :: OrdList a -> OrdList a
reverseOL None = OrdList a
forall a. OrdList a
None
reverseOL (One x :: a
x) = a -> OrdList a
forall a. a -> OrdList a
One a
x
reverseOL (Cons a :: a
a b :: OrdList a
b) = OrdList a -> a -> OrdList a
forall a. OrdList a -> a -> OrdList a
Snoc (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
b) a
a
reverseOL (Snoc a :: OrdList a
a b :: a
b) = a -> OrdList a -> OrdList a
forall a. a -> OrdList a -> OrdList a
Cons a
b (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
a)
reverseOL (Two a :: OrdList a
a b :: OrdList a
b) = OrdList a -> OrdList a -> OrdList a
forall a. OrdList a -> OrdList a -> OrdList a
Two (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
b) (OrdList a -> OrdList a
forall a. OrdList a -> OrdList a
reverseOL OrdList a
a)
reverseOL (Many xs :: [a]
xs) = [a] -> OrdList a
forall a. [a] -> OrdList a
Many ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs)
strictlyEqOL :: Eq a => OrdList a -> OrdList a -> Bool
strictlyEqOL :: OrdList a -> OrdList a -> Bool
strictlyEqOL None None = Bool
True
strictlyEqOL (One x :: a
x) (One y :: a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
strictlyEqOL (Cons a :: a
a as :: OrdList a
as) (Cons b :: a
b bs :: OrdList a
bs) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& OrdList a
as OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
bs
strictlyEqOL (Snoc as :: OrdList a
as a :: a
a) (Snoc bs :: OrdList a
bs b :: a
b) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& OrdList a
as OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
bs
strictlyEqOL (Two a1 :: OrdList a
a1 a2 :: OrdList a
a2) (Two b1 :: OrdList a
b1 b2 :: OrdList a
b2) = OrdList a
a1 OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
b1 Bool -> Bool -> Bool
&& OrdList a
a2 OrdList a -> OrdList a -> Bool
forall a. Eq a => OrdList a -> OrdList a -> Bool
`strictlyEqOL` OrdList a
b2
strictlyEqOL (Many as :: [a]
as) (Many bs :: [a]
bs) = [a]
as [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
bs
strictlyEqOL _ _ = Bool
False
strictlyOrdOL :: Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL :: OrdList a -> OrdList a -> Ordering
strictlyOrdOL None None = Ordering
EQ
strictlyOrdOL None _ = Ordering
LT
strictlyOrdOL (One x :: a
x) (One y :: a
y) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y
strictlyOrdOL (One _) _ = Ordering
LT
strictlyOrdOL (Cons a :: a
a as :: OrdList a
as) (Cons b :: a
b bs :: OrdList a
bs) =
a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
as OrdList a
bs
strictlyOrdOL (Cons _ _) _ = Ordering
LT
strictlyOrdOL (Snoc as :: OrdList a
as a :: a
a) (Snoc bs :: OrdList a
bs b :: a
b) =
a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
a a
b Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
as OrdList a
bs
strictlyOrdOL (Snoc _ _) _ = Ordering
LT
strictlyOrdOL (Two a1 :: OrdList a
a1 a2 :: OrdList a
a2) (Two b1 :: OrdList a
b1 b2 :: OrdList a
b2) =
(OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
a1 OrdList a
b1) Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend` (OrdList a -> OrdList a -> Ordering
forall a. Ord a => OrdList a -> OrdList a -> Ordering
strictlyOrdOL OrdList a
a2 OrdList a
b2)
strictlyOrdOL (Two _ _) _ = Ordering
LT
strictlyOrdOL (Many as :: [a]
as) (Many bs :: [a]
bs) = [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
as [a]
bs
strictlyOrdOL (Many _ ) _ = Ordering
GT