module Language.Lexer.Tlex.Data.Bag (
    Bag,
    fromList,
    singleton,
) where

import           Language.Lexer.Tlex.Prelude


data Bag a
    = EmptyBag
    | UnitBag a
    | IncludeBags (Bag a) (Bag a)
    | ListBag [a]
    deriving (Int -> Bag a -> ShowS
[Bag a] -> ShowS
Bag a -> String
(Int -> Bag a -> ShowS)
-> (Bag a -> String) -> ([Bag a] -> ShowS) -> Show (Bag a)
forall a. Show a => Int -> Bag a -> ShowS
forall a. Show a => [Bag a] -> ShowS
forall a. Show a => Bag a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bag a] -> ShowS
$cshowList :: forall a. Show a => [Bag a] -> ShowS
show :: Bag a -> String
$cshow :: forall a. Show a => Bag a -> String
showsPrec :: Int -> Bag a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Bag a -> ShowS
Show, a -> Bag b -> Bag a
(a -> b) -> Bag a -> Bag b
(forall a b. (a -> b) -> Bag a -> Bag b)
-> (forall a b. a -> Bag b -> Bag a) -> Functor Bag
forall a b. a -> Bag b -> Bag a
forall a b. (a -> b) -> Bag a -> Bag b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bag b -> Bag a
$c<$ :: forall a b. a -> Bag b -> Bag a
fmap :: (a -> b) -> Bag a -> Bag b
$cfmap :: forall a b. (a -> b) -> Bag a -> Bag b
Functor)

instance Foldable Bag where
    foldr :: (a -> b -> b) -> b -> Bag a -> b
foldr a -> b -> b
k b
z = \case
        Bag a
EmptyBag          -> b
z
        UnitBag a
x         -> a -> b -> b
k a
x b
z
        IncludeBags Bag a
b1 Bag a
b2 -> (a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k ((a -> b -> b) -> b -> Bag a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
k b
z Bag a
b2) Bag a
b1
        ListBag [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

    foldMap :: (a -> m) -> Bag a -> m
foldMap a -> m
f = \case
        Bag a
EmptyBag          -> m
forall a. Monoid a => a
mempty
        UnitBag a
x         -> a -> m
f a
x
        IncludeBags Bag a
b1 Bag a
b2 -> (a -> m) -> Bag a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Bag a
b1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Bag a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Bag a
b2
        ListBag [a]
xs        -> (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
xs

instance Eq a => Eq (Bag a) where
    Bag a
b1 == :: Bag a -> Bag a -> Bool
== Bag a
b2 = Bag a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Bag a
b1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== Bag a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Bag a
b2

instance Semigroup (Bag a) where
    Bag a
EmptyBag <> :: Bag a -> Bag a -> Bag a
<> Bag a
b2 = Bag a
b2
    Bag a
b1 <> Bag a
EmptyBag = Bag a
b1
    Bag a
b1 <> Bag a
b2       = Bag a -> Bag a -> Bag a
forall a. Bag a -> Bag a -> Bag a
IncludeBags Bag a
b1 Bag a
b2

instance Monoid (Bag a) where
    mempty :: Bag a
mempty = Bag a
forall a. Bag a
EmptyBag

fromList :: [a] -> Bag a
fromList :: [a] -> Bag a
fromList [a]
xs = [a] -> Bag a
forall a. [a] -> Bag a
ListBag [a]
xs

singleton :: a -> Bag a
singleton :: a -> Bag a
singleton a
x = a -> Bag a
forall a. a -> Bag a
UnitBag a
x