{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}
module PlutusTx.Monoid (Monoid (..), mappend, mconcat, Group (..), gsub) where
import Data.Monoid (First (..))
import Data.Semigroup (Dual (..), Endo (..))
import PlutusTx.Base (id)
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.List
import PlutusTx.Maybe
import PlutusTx.Semigroup
class (Semigroup a) => Monoid a where
mempty :: a
mappend :: (Monoid a) => a -> a -> a
mappend :: forall a. Monoid a => a -> a -> a
mappend = a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINEABLE mappend #-}
mconcat :: (Monoid a) => [a] -> a
mconcat :: forall a. Monoid a => [a] -> a
mconcat = (a -> a -> a) -> a -> [a] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Monoid a => a
mempty
{-# INLINEABLE mconcat #-}
instance Monoid Builtins.BuiltinByteString where
{-# INLINEABLE mempty #-}
mempty :: BuiltinByteString
mempty = BuiltinByteString
Builtins.emptyByteString
instance Monoid Builtins.BuiltinString where
{-# INLINEABLE mempty #-}
mempty :: BuiltinString
mempty = BuiltinString
Builtins.emptyString
instance Monoid [a] where
{-# INLINEABLE mempty #-}
mempty :: [a]
mempty = []
instance (Semigroup a) => Monoid (Maybe a) where
{-# INLINEABLE mempty #-}
mempty :: Maybe a
mempty = Maybe a
forall a. Maybe a
Nothing
instance Monoid () where
{-# INLINEABLE mempty #-}
mempty :: ()
mempty = ()
instance (Monoid a, Monoid b) => Monoid (a, b) where
{-# INLINEABLE mempty #-}
mempty :: (a, b)
mempty = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty)
instance (Monoid a) => Monoid (Dual a) where
{-# INLINEABLE mempty #-}
mempty :: Dual a
mempty = a -> Dual a
forall a. a -> Dual a
Dual a
forall a. Monoid a => a
mempty
instance Monoid (Endo a) where
{-# INLINEABLE mempty #-}
mempty :: Endo a
mempty = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo a -> a
forall a. a -> a
id
instance Monoid (First a) where
{-# INLINEABLE mempty #-}
mempty :: First a
mempty = Maybe a -> First a
forall a. Maybe a -> First a
First Maybe a
forall a. Maybe a
Nothing
class (Monoid a) => Group a where
inv :: a -> a
gsub :: (Group a) => a -> a -> a
gsub :: forall a. Group a => a -> a -> a
gsub a
x a
y = a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a
forall a. Group a => a -> a
inv a
y
{-# INLINEABLE gsub #-}