{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | This module provides a linear version of 'Semigroup'.
module Data.Monoid.Linear.Internal.Semigroup
  ( -- * Semigroup
    Semigroup(..)
    -- * Endo
  , Endo(..), appEndo
  , NonLinear(..)
  , module Data.Semigroup
  )
  where

import Prelude.Linear.Internal
import Data.Semigroup hiding (Semigroup(..), Endo(..))
import qualified Data.Semigroup as Prelude
import GHC.Types hiding (Any)

-- | A linear semigroup @a@ is a type with an associative binary operation @<>@
-- that linearly consumes two @a@s.
class Prelude.Semigroup a => Semigroup a where
  (<>) :: a %1-> a %1-> a

---------------
-- Instances --
---------------

instance Semigroup () where
  () <> :: () %1 -> () %1 -> ()
<> () = ()

-- | An @Endo a@ is just a linear function of type @a %1-> a@.
-- This has a classic monoid definition with 'id' and '(.)'.
newtype Endo a = Endo (a %1-> a)
  deriving (NonEmpty (Endo a) -> Endo a
Endo a -> Endo a -> Endo a
(Endo a -> Endo a -> Endo a)
-> (NonEmpty (Endo a) -> Endo a)
-> (forall b. Integral b => b -> Endo a -> Endo a)
-> Semigroup (Endo a)
forall b. Integral b => b -> Endo a -> Endo a
forall a. NonEmpty (Endo a) -> Endo a
forall a. Endo a -> Endo a -> Endo a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Endo a -> Endo a
stimes :: forall b. Integral b => b -> Endo a -> Endo a
$cstimes :: forall a b. Integral b => b -> Endo a -> Endo a
sconcat :: NonEmpty (Endo a) -> Endo a
$csconcat :: forall a. NonEmpty (Endo a) -> Endo a
<> :: Endo a -> Endo a -> Endo a
$c<> :: forall a. Endo a -> Endo a -> Endo a
Prelude.Semigroup) via NonLinear (Endo a)

-- TODO: have this as a newtype deconstructor once the right type can be
-- correctly inferred
-- | A linear application of an 'Endo'.
appEndo :: Endo a %1-> a %1-> a
appEndo :: forall a. Endo a %1 -> a %1 -> a
appEndo (Endo a %1 -> a
f) = a %1 -> a
f

instance Semigroup (Endo a) where
  Endo a %1 -> a
f <> :: Endo a %1 -> Endo a %1 -> Endo a
<> Endo a %1 -> a
g = (a %1 -> a) %1 -> Endo a
forall a. (a %1 -> a) -> Endo a
Endo (a %1 -> a
f (a %1 -> a) %1 -> (a %1 -> a) %1 -> a %1 -> a
forall b c a. (b %1 -> c) %1 -> (a %1 -> b) %1 -> a %1 -> c
. a %1 -> a
g)

instance (Semigroup a, Semigroup b) => Semigroup (a,b) where
  (a
a,b
x) <> :: (a, b) %1 -> (a, b) %1 -> (a, b)
<> (a
b,b
y) = (a
a a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
b, b
x b %1 -> b %1 -> b
forall a. Semigroup a => a %1 -> a %1 -> a
<> b
y)

instance Semigroup a => Semigroup (Dual a) where
  Dual a
x <> :: Dual a %1 -> Dual a %1 -> Dual a
<> Dual a
y = a %1 -> Dual a
forall a. a -> Dual a
Dual (a
y a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
x)

instance Semigroup All where
  All Bool
False <> :: All %1 -> All %1 -> All
<> All Bool
False = Bool -> All
All Bool
False
  All Bool
False <> All Bool
True = Bool -> All
All Bool
False
  All Bool
True  <> All Bool
False = Bool -> All
All Bool
False
  All Bool
True  <> All Bool
True = Bool -> All
All Bool
True
instance Semigroup Any where
  Any Bool
False <> :: Any %1 -> Any %1 -> Any
<> Any Bool
False = Bool -> Any
Any Bool
False
  Any Bool
False <> Any Bool
True = Bool -> Any
Any Bool
True
  Any Bool
True  <> Any Bool
False = Bool -> Any
Any Bool
True
  Any Bool
True  <> Any Bool
True = Bool -> Any
Any Bool
True

-- | DerivingVia combinator for Prelude.Semigroup given (linear) Semigroup.
-- For linear monoids, you should supply a Prelude.Monoid instance and either
-- declare an empty Monoid instance, or use DeriveAnyClass. For example:
--
-- > newtype Endo a = Endo (a %1-> a)
-- >   deriving (Prelude.Semigroup) via NonLinear (Endo a)
newtype NonLinear a = NonLinear a

instance Semigroup a => Prelude.Semigroup (NonLinear a) where
  NonLinear a
a <> :: NonLinear a -> NonLinear a -> NonLinear a
<> NonLinear a
b = a -> NonLinear a
forall a. a -> NonLinear a
NonLinear (a
a a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
b)

instance Semigroup Ordering where
    Ordering
LT <> :: Ordering %1 -> Ordering %1 -> Ordering
<> Ordering
LT = Ordering
LT
    Ordering
LT <> Ordering
GT = Ordering
LT
    Ordering
LT <> Ordering
EQ = Ordering
LT
    Ordering
EQ <> Ordering
y = Ordering
y
    Ordering
GT <> Ordering
LT = Ordering
GT
    Ordering
GT <> Ordering
GT = Ordering
GT
    Ordering
GT <> Ordering
EQ = Ordering
GT
    -- We can not use `lseq` above because of an import loop.
    -- So it's easier to just expand the cases here.