module UVMHS.Core.Classes.Monoid where

import UVMHS.Core.Init

import UVMHS.Core.Classes.Functors

infixl 5 ⧺
infixl 6 ⨳
infixl 7 ▷

class Null a where null ∷ a
class Append a where (⧺) ∷ a → a → a
class (Null a,Append a) ⇒ Monoid a

prepend ∷ (Append a) ⇒ a → a → a
prepend :: forall a. Append a => a -> a -> a
prepend = a -> a -> a
forall a. Append a => a -> a -> a
(⧺)

pospend ∷ (Append a) ⇒ a → a → a
pospend :: forall a. Append a => a -> a -> a
pospend = (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Append a => a -> a -> a
(⧺)

class Unit a where unit ∷ a
class Cross a where (⨳) ∷ a → a → a
class (Monoid a,Unit a,Cross a) ⇒ Prodoid a

class Eps a where eps ∷ a
class Seq a where (▷) ∷ a → a → a
class (Eps a,Seq a) ⇒ Seqoid a

opt ∷ (Append a,Eps a) ⇒ a → a
opt :: forall a. (Append a, Eps a) => a -> a
opt a
x = a
x a -> a -> a
forall a. Append a => a -> a -> a
⧺ a
forall a. Eps a => a
eps

class Star a where star ∷ a → a
class (Seqoid a,Star a) ⇒ Kleene a

oom ∷ (Kleene a) ⇒ a → a
oom :: forall a. Kleene a => a -> a
oom a
x = a
x a -> a -> a
forall a. Seq a => a -> a -> a
▷ a -> a
forall a. Star a => a -> a
star a
x

newtype Compose a = Compose { forall a. Compose a -> a -> a
unCompose ∷ a → a }

instance Null (Compose a) where null :: Compose a
null = (a -> a) -> Compose a
forall a. (a -> a) -> Compose a
Compose a -> a
forall a. a -> a
id
instance Append (Compose a) where Compose a
g ⧺ :: Compose a -> Compose a -> Compose a
⧺ Compose a
f = (a -> a) -> Compose a
forall a. (a -> a) -> Compose a
Compose ((a -> a) -> Compose a) -> (a -> a) -> Compose a
forall a b. (a -> b) -> a -> b
$ Compose a -> a -> a
forall a. Compose a -> a -> a
unCompose Compose a
g (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
∘ Compose a -> a -> a
forall a. Compose a -> a -> a
unCompose Compose a
f
instance Monoid (Compose a)

newtype MCompose m a = MCompose { forall (m :: * -> *) a. MCompose m a -> a -> m a
unMCompose ∷ a → m a }

instance (Return m) ⇒ Null (MCompose m a) where null :: MCompose m a
null = (a -> m a) -> MCompose m a
forall (m :: * -> *) a. (a -> m a) -> MCompose m a
MCompose a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Return m => a -> m a
return
instance (Bind m) ⇒ Append (MCompose m a) where MCompose m a
g ⧺ :: MCompose m a -> MCompose m a -> MCompose m a
⧺ MCompose m a
f = (a -> m a) -> MCompose m a
forall (m :: * -> *) a. (a -> m a) -> MCompose m a
MCompose ((a -> m a) -> MCompose m a) -> (a -> m a) -> MCompose m a
forall a b. (a -> b) -> a -> b
$ MCompose m a -> a -> m a
forall (m :: * -> *) a. MCompose m a -> a -> m a
unMCompose MCompose m a
g (a -> m a) -> (a -> m a) -> a -> m a
forall (m :: * -> *) b c a.
Bind m =>
(b -> m c) -> (a -> m b) -> a -> m c
*∘ MCompose m a -> a -> m a
forall (m :: * -> *) a. MCompose m a -> a -> m a
unMCompose MCompose m a
f
instance (Monad m) ⇒ Monoid (MCompose m a)