{-# 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

{- HLINT ignore -}

-- | Plutus Tx version of 'Data.Monoid.Monoid'.
class (Semigroup a) => Monoid a where
  -- | Plutus Tx version of 'Data.Monoid.mempty'.
  mempty :: a

-- mappend and mconcat deliberately omitted, to make this a one-method class which has a
-- simpler representation

-- | Plutus Tx version of 'Data.Monoid.mappend'.
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 #-}

-- | Plutus Tx version of 'Data.Monoid.mconcat'.
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 #-}