{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module PlutusTx.Semigroup (Semigroup (..), Max (..), Min (..)) where

import Data.Coerce (coerce)
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
  {-# INLINEABLE (<>) #-}
  <> :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString
(<>) = BuiltinByteString -> BuiltinByteString -> BuiltinByteString
Builtins.appendByteString

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

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

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
  {-# INLINEABLE (<>) #-}
  (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
  {-# INLINEABLE (<>) #-}
  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
  {-# INLINEABLE (<>) #-}
  <> :: Endo a -> Endo a -> Endo a
(<>) = ((a -> a) -> (a -> a) -> a -> a) -> Endo a -> Endo a -> Endo a
forall a b. Coercible a b => a -> b
coerce ((a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) :: (a -> a) -> (a -> a) -> a -> a)

instance Semigroup (First a) where
  {-# INLINEABLE (<>) #-}
  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 {forall a. Max a -> a
getMax :: a}

instance Functor Max where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Max a -> Max b
fmap = (a -> b) -> Max a -> Max b
forall a b. Coercible a b => a -> b
coerce

instance (Ord a) => Semigroup (Max a) where
  {-# INLINEABLE (<>) #-}
  <> :: Max a -> Max a -> Max a
(<>) = (a -> a -> a) -> Max a -> Max a -> Max a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Ord a => a -> a -> a
max :: a -> a -> a)

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

instance Functor Min where
  {-# INLINEABLE fmap #-}
  fmap :: forall a b. (a -> b) -> Min a -> Min b
fmap = (a -> b) -> Min a -> Min b
forall a b. Coercible a b => a -> b
coerce

instance (Ord a) => Semigroup (Min a) where
  {-# INLINEABLE (<>) #-}
  <> :: Min a -> Min a -> Min a
(<>) = (a -> a -> a) -> Min a -> Min a -> Min a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Ord a => a -> a -> a
min :: a -> a -> a)