-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Also known as a conc-list or a merge-list.  In the ghc source it's called
-- OrdList.
module Util.AppendList (
    AppendList, empty, singleton, cons, snoc, append
    , fromList, toList
    , length, view, head, last
) where
import           Prelude hiding (length, head, last)
import qualified Data.List as List

import           Control.Monad


data AppendList a =
    Nil | Single a | Pair (AppendList a) (AppendList a) | Many [a]
    deriving (AppendList a -> AppendList a -> Bool
forall a. Eq a => AppendList a -> AppendList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppendList a -> AppendList a -> Bool
$c/= :: forall a. Eq a => AppendList a -> AppendList a -> Bool
== :: AppendList a -> AppendList a -> Bool
$c== :: forall a. Eq a => AppendList a -> AppendList a -> Bool
Eq, Int -> AppendList a -> ShowS
forall a. Show a => Int -> AppendList a -> ShowS
forall a. Show a => [AppendList a] -> ShowS
forall a. Show a => AppendList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AppendList a] -> ShowS
$cshowList :: forall a. Show a => [AppendList a] -> ShowS
show :: AppendList a -> String
$cshow :: forall a. Show a => AppendList a -> String
showsPrec :: Int -> AppendList a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AppendList a -> ShowS
Show)

instance Functor AppendList where
    fmap :: forall a b. (a -> b) -> AppendList a -> AppendList b
fmap a -> b
_ AppendList a
Nil = forall a. AppendList a
Nil
    fmap a -> b
f (Single a
x) = forall a. a -> AppendList a
Single (a -> b
f a
x)
    fmap a -> b
f (Pair AppendList a
xs AppendList a
ys) = forall a. AppendList a -> AppendList a -> AppendList a
Pair (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f AppendList a
xs) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f AppendList a
ys)
    fmap a -> b
f (Many [a]
xs) = forall a. [a] -> AppendList a
Many (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)

instance Semigroup (AppendList a) where
    <> :: AppendList a -> AppendList a -> AppendList a
(<>) = forall a. AppendList a -> AppendList a -> AppendList a
append

instance Monoid (AppendList a) where
    mempty :: AppendList a
mempty = forall a. AppendList a
empty

empty :: AppendList a
empty :: forall a. AppendList a
empty = forall a. AppendList a
Nil

singleton :: a -> AppendList a
singleton :: forall a. a -> AppendList a
singleton = forall a. a -> AppendList a
Single

cons :: a -> AppendList a -> AppendList a
cons :: forall a. a -> AppendList a -> AppendList a
cons a
x AppendList a
Nil = forall a. a -> AppendList a
Single a
x
cons a
x AppendList a
xs = forall a. AppendList a -> AppendList a -> AppendList a
Pair (forall a. a -> AppendList a
Single a
x) AppendList a
xs

snoc :: AppendList a -> a -> AppendList a
snoc :: forall a. AppendList a -> a -> AppendList a
snoc AppendList a
Nil a
x = forall a. a -> AppendList a
Single a
x
snoc AppendList a
xs a
x = forall a. AppendList a -> AppendList a -> AppendList a
Pair AppendList a
xs (forall a. a -> AppendList a
Single a
x)

append :: AppendList a -> AppendList a -> AppendList a
append :: forall a. AppendList a -> AppendList a -> AppendList a
append AppendList a
Nil AppendList a
ys = AppendList a
ys
append AppendList a
xs AppendList a
Nil = AppendList a
xs
append AppendList a
xs AppendList a
ys = forall a. AppendList a -> AppendList a -> AppendList a
Pair AppendList a
xs AppendList a
ys

fromList :: [a] -> AppendList a
fromList :: forall a. [a] -> AppendList a
fromList [] = forall a. AppendList a
Nil
fromList [a
a] = forall a. a -> AppendList a
Single a
a
fromList xs :: [a]
xs@(a
_:[a]
_) = forall a. [a] -> AppendList a
Many [a]
xs

toList :: AppendList a -> [a]
toList :: forall a. AppendList a -> [a]
toList AppendList a
alist = forall {a}. AppendList a -> [a] -> [a]
go AppendList a
alist []
    where
    go :: AppendList a -> [a] -> [a]
go AppendList a
Nil [a]
xs = [a]
xs
    go (Single a
x) [a]
xs = a
x forall a. a -> [a] -> [a]
: [a]
xs
    go (Pair AppendList a
xs1 AppendList a
xs2) [a]
ys = AppendList a -> [a] -> [a]
go AppendList a
xs1 (AppendList a -> [a] -> [a]
go AppendList a
xs2 [a]
ys)
    go (Many [a]
xs) [a]
ys = [a]
xs forall a. [a] -> [a] -> [a]
++ [a]
ys

length :: AppendList a -> Int
length :: forall a. AppendList a -> Int
length AppendList a
Nil = Int
0
length (Single a
_) = Int
1
length (Pair AppendList a
xs AppendList a
ys) = forall a. AppendList a -> Int
length AppendList a
xs forall a. Num a => a -> a -> a
+ forall a. AppendList a -> Int
length AppendList a
ys
-- possibly more efficient if the list is built with 'snoc'?
-- length (Pair xs ys) = let leny = length ys in leny `seq` leny + length xs
length (Many [a]
xs) = forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
xs

view :: AppendList a -> Maybe (a, AppendList a)
view :: forall a. AppendList a -> Maybe (a, AppendList a)
view AppendList a
Nil = forall a. Maybe a
Nothing
view (Single a
a) = forall a. a -> Maybe a
Just (a
a, forall a. AppendList a
Nil)
view (Pair AppendList a
xs AppendList a
ys) = case forall a. AppendList a -> Maybe (a, AppendList a)
view AppendList a
xs of
    Maybe (a, AppendList a)
Nothing -> forall a. AppendList a -> Maybe (a, AppendList a)
view AppendList a
ys
    Just (a
v, AppendList a
Nil) -> forall a. a -> Maybe a
Just (a
v, AppendList a
ys)
    Just (a
v, Many []) -> forall a. a -> Maybe a
Just (a
v, AppendList a
ys)
    Just (a
v, AppendList a
rest) -> forall a. a -> Maybe a
Just (a
v, forall a. AppendList a -> AppendList a -> AppendList a
Pair AppendList a
rest AppendList a
ys)
view (Many []) = forall a. Maybe a
Nothing
view (Many (a
x:[a]
xs)) = forall a. a -> Maybe a
Just (a
x, forall a. [a] -> AppendList a
Many [a]
xs)

head :: AppendList a -> Maybe a
head :: forall a. AppendList a -> Maybe a
head AppendList a
Nil = forall a. Maybe a
Nothing
head (Single a
a) = forall a. a -> Maybe a
Just a
a
head (Pair AppendList a
xs AppendList a
ys) = forall a. AppendList a -> Maybe a
head AppendList a
xs forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. AppendList a -> Maybe a
head AppendList a
ys
head (Many []) = forall a. Maybe a
Nothing
head (Many (a
x:[a]
_)) = forall a. a -> Maybe a
Just a
x

last :: AppendList a -> Maybe a
last :: forall a. AppendList a -> Maybe a
last AppendList a
Nil = forall a. Maybe a
Nothing
last (Single a
a) = forall a. a -> Maybe a
Just a
a
last (Pair AppendList a
xs AppendList a
ys) = forall a. AppendList a -> Maybe a
last AppendList a
ys forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall a. AppendList a -> Maybe a
last AppendList a
xs
last (Many []) = forall a. Maybe a
Nothing
last (Many [a]
xs) = forall a. a -> Maybe a
Just (forall a. [a] -> a
List.last [a]
xs)