{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
module PlutusTx.Semigroup (Semigroup (..), Max (..), Min (..)) where

import Data.Monoid (First (..))
import Data.Semigroup (Dual (..), Endo (..))
import PlutusTx.Base
import PlutusTx.Builtins qualified as Builtins
import PlutusTx.Functor
import PlutusTx.List ((++))
import PlutusTx.Ord (Ord (..), Ordering (..))
import Prelude (Maybe (..))

{- HLINT ignore -}

infixr 6 <>

-- | Plutus Tx version of 'Data.Semigroup.Semigroup'.
class Semigroup a where
    -- | Plutus Tx version of '(Data.Semigroup.<>)'.
    (<>) :: a -> a -> a
    -- sconcat and stimes deliberately omitted, to make this a one-method class which has a
    -- simpler representation

instance Semigroup Builtins.BuiltinByteString where
    {-# INLINABLE (<>) #-}
    <> :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString
(<>) = BuiltinByteString -> BuiltinByteString -> BuiltinByteString
Builtins.appendByteString

instance Semigroup Builtins.BuiltinString where
    {-# INLINABLE (<>) #-}
    <> :: BuiltinString -> BuiltinString -> BuiltinString
(<>) = BuiltinString -> BuiltinString -> BuiltinString
Builtins.appendString

instance Semigroup [a] where
    {-# INLINABLE (<>) #-}
    <> :: [a] -> [a] -> [a]
(<>) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
    {-# INLINABLE (<>) #-}
    (a
a1, b
b1) <> :: (a, b) -> (a, b) -> (a, b)
<> (a
a2, b
b2) = (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a2, b
b1 b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
b2)

instance Semigroup a => Semigroup (Maybe a) where
    Just a
a1 <> :: Maybe a -> Maybe a -> Maybe a
<> Just a
a2 = a -> Maybe a
forall a. a -> Maybe a
Just (a
a1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a2)
    Just a
a1 <> Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just a
a1
    Maybe a
Nothing <> Just a
a2 = a -> Maybe a
forall a. a -> Maybe a
Just a
a2
    Maybe a
Nothing <> Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing

instance Semigroup Ordering where
    Ordering
LT <> :: Ordering -> Ordering -> Ordering
<> Ordering
_ = Ordering
LT
    Ordering
EQ <> Ordering
y = Ordering
y
    Ordering
GT <> Ordering
_ = Ordering
GT

instance Semigroup () where
    ()
_ <> :: () -> () -> ()
<> ()
_ = ()

instance Semigroup a => Semigroup (Dual a) where
    {-# INLINABLE (<>) #-}
    Dual a
a1 <> :: Dual a -> Dual a -> Dual a
<> Dual a
a2 = a -> Dual a
forall a. a -> Dual a
Dual (a
a2 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
a1)

instance Semigroup (Endo a) where
    {-# INLINABLE (<>) #-}
    Endo a -> a
f1 <> :: Endo a -> Endo a -> Endo a
<> Endo a -> a
f2 = (a -> a) -> Endo a
forall a. (a -> a) -> Endo a
Endo (a -> a
f1 (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f2)

instance Semigroup (First a) where
    {-# INLINABLE (<>) #-}
    First Maybe a
Nothing <> :: First a -> First a -> First a
<> First a
b = First a
b
    First a
a             <> First a
_ = First a
a

newtype Max a = Max { Max a -> a
getMax :: a }

instance Functor Max where
    {-# INLINABLE fmap #-}
    fmap :: (a -> b) -> Max a -> Max b
fmap a -> b
f (Max a
a) = b -> Max b
forall a. a -> Max a
Max (a -> b
f a
a)

instance Ord a => Semigroup (Max a) where
    {-# INLINABLE (<>) #-}
    (Max a
a1) <> :: Max a -> Max a -> Max a
<> (Max a
a2) = a -> Max a
forall a. a -> Max a
Max (a -> a -> a
forall a. Ord a => a -> a -> a
max a
a1 a
a2)

newtype Min a = Min { Min a -> a
getMin :: a }

instance Functor Min where
    {-# INLINABLE fmap #-}
    fmap :: (a -> b) -> Min a -> Min b
fmap a -> b
f (Min a
a) = b -> Min b
forall a. a -> Min a
Min (a -> b
f a
a)

instance Ord a => Semigroup (Min a) where
    {-# INLINABLE (<>) #-}
    (Min a
a1) <> :: Min a -> Min a -> Min a
<> (Min a
a2) = a -> Min a
forall a. a -> Min a
Min (a -> a -> a
forall a. Ord a => a -> a -> a
min a
a1 a
a2)