{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}

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

    -- * Endo
    Endo (..),
    appEndo,

    -- * NonLinear newtype
    NonLinear (..),

    -- * Data.Semigroup reexports
    All (..),
    Any (..),
    First (..),
    Last (..),
    Dual (..),
    Sum (..),
    Product (..),
  )
where

import qualified Data.Functor.Compose as Functor
import Data.Functor.Const (Const (..))
import Data.Functor.Identity (Identity (..))
import qualified Data.Functor.Product as Functor
import qualified Data.Monoid as Monoid
import Data.Ord (Down (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup
  ( All (..),
    Any (..),
    Dual (..),
    First (..),
    Last (..),
    Product (..),
    Sum (..),
  )
import qualified Data.Semigroup as Prelude
import Data.Unrestricted.Linear.Internal.Consumable (Consumable, lseq)
import Data.Void (Void)
import GHC.Tuple
import GHC.Types hiding (Any)
import Prelude.Linear.Internal
import Prelude (Either (..), Maybe (..))

-- | A linear semigroup @a@ is a type with an associative binary operation @<>@
-- that linearly consumes two @a@s.
--
-- Laws (same as 'Data.Semigroup.Semigroup'):
--   * ∀ x ∈ G, y ∈ G, z ∈ G, x <> (y <> z) = (x <> y) <> z
class Semigroup a where
  (<>) :: a %1 -> a %1 -> a
  infixr 6 <> -- same fixity as base.<>

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

-- | @DerivingVia@ combinator for 'Prelude.Semigroup' (resp. 'Prelude.Monoid')
-- given linear 'Semigroup' (resp. 'Monoid').
--
-- > newtype Endo a = Endo (a %1-> a)
-- >   deriving (Prelude.Semigroup) via NonLinear (Endo a)
newtype NonLinear a = NonLinear a

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

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

-- Instances below are listed in the same order as in https://hackage.haskell.org/package/base-4.16.0.0/docs/Data-Semigroup.html

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

instance Semigroup Void where
  <> :: Void %1 -> Void %1 -> Void
(<>) = \case {}

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

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

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

instance Consumable a => Semigroup (Monoid.First a) where
  (Monoid.First Maybe a
Nothing) <> :: First a %1 -> First a %1 -> First a
<> First a
y = First a
y
  First a
x <> (Monoid.First Maybe a
y) =
    Maybe a
y forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
      Maybe a
Nothing -> First a
x
      Just a
y' -> a
y' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` First a
x

instance Consumable a => Semigroup (Monoid.Last a) where
  Last a
x <> :: Last a %1 -> Last a %1 -> Last a
<> (Monoid.Last Maybe a
Nothing) = Last a
x
  (Monoid.Last Maybe a
x) <> Last a
y =
    Maybe a
x forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
      Maybe a
Nothing -> Last a
y
      Just a
x' -> a
x' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Last a
y

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

instance Consumable a => Semigroup (First a) where
  First a
x <> :: First a %1 -> First a %1 -> First a
<> (First a
y) = a
y forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` First a
x

instance Consumable a => Semigroup (Last a) where
  (Last a
x) <> :: Last a %1 -> Last a %1 -> Last a
<> Last a
y = a
x forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Last a
y

-- Cannot add instance Ord a => Semigroup (Max a); would require (NonLinear.Ord a, Consumable a)
-- Cannot add instance Ord a => Semigroup (Min a); would require (NonLinear.Ord a, Consumable a)

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

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

-- See Data.Num.Linear for instance ... => Semigroup (Product a)
-- See Data.Num.Linear for instance ... => Semigroup (Sum a)
-- See System.IO.Linear for instance ... => Semigroup (IO a)
-- See System.IO.Resource.Internal for instance ... => Semigroup (RIO a)
-- See Data.List.Linear for instance ... => Semigroup (NonEmpty a)

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

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

-- See Data.List.Linear for instance ... => Semigroup [a]

instance (Consumable a, Consumable b) => Semigroup (Either a b) where
  Left a
x <> :: Either a b %1 -> Either a b %1 -> Either a b
<> Either a b
y = a
x forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Either a b
y
  Either a b
x <> Either a b
y =
    Either a b
y forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \case
      Left a
y' -> a
y' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Either a b
x
      Right b
y' -> b
y' forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Either a b
x

-- Cannot add instance Semigroup a => Semigroup (Op a b); would require Dupable b

instance Semigroup (Proxy a) where
  Proxy a
Proxy <> :: Proxy a %1 -> Proxy a %1 -> Proxy a
<> Proxy a
Proxy = forall {k} (t :: k). Proxy t
Proxy

-- Cannot add instance Semigroup a => Semigroup (ST s a); I think that it would require a linear ST monad
-- Cannot add instance Semigroup b => Semigroup (a -> b); would require Dupable a

instance (Semigroup a, Semigroup b) => Semigroup (a, b) where
  (a
x1, b
x2) <> :: (a, b) %1 -> (a, b) %1 -> (a, b)
<> (a
y1, b
y2) = (a
x1 forall a. Semigroup a => a %1 -> a %1 -> a
<> a
y1, b
x2 forall a. Semigroup a => a %1 -> a %1 -> a
<> b
y2)

instance Semigroup a => Semigroup (Const a b) where
  Const a
x <> :: Const a b %1 -> Const a b %1 -> Const a b
<> Const a
y = forall {k} a (b :: k). a -> Const a b
Const (a
x forall a. Semigroup a => a %1 -> a %1 -> a
<> a
y)

-- See Data.Functor.Linear.Applicative for instance ... => Semigroup (Ap f a)
-- Cannot add instance Alternative f => Semigroup (Alt f a); we don't have a linear Alternative

instance (Semigroup a, Semigroup b, Semigroup c) => Semigroup (a, b, c) where
  (a
x1, b
x2, c
x3) <> :: (a, b, c) %1 -> (a, b, c) %1 -> (a, b, c)
<> (a
y1, b
y2, c
y3) = (a
x1 forall a. Semigroup a => a %1 -> a %1 -> a
<> a
y1, b
x2 forall a. Semigroup a => a %1 -> a %1 -> a
<> b
y2, c
x3 forall a. Semigroup a => a %1 -> a %1 -> a
<> c
y3)

instance (Semigroup (f a), Semigroup (g a)) => Semigroup (Functor.Product f g a) where
  Functor.Pair f a
x1 g a
x2 <> :: Product f g a %1 -> Product f g a %1 -> Product f g a
<> Functor.Pair f a
y1 g a
y2 = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Functor.Pair (f a
x1 forall a. Semigroup a => a %1 -> a %1 -> a
<> f a
y1) (g a
x2 forall a. Semigroup a => a %1 -> a %1 -> a
<> g a
y2)

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d) => Semigroup (a, b, c, d) where
  (a
x1, b
x2, c
x3, d
x4) <> :: (a, b, c, d) %1 -> (a, b, c, d) %1 -> (a, b, c, d)
<> (a
y1, b
y2, c
y3, d
y4) = (a
x1 forall a. Semigroup a => a %1 -> a %1 -> a
<> a
y1, b
x2 forall a. Semigroup a => a %1 -> a %1 -> a
<> b
y2, c
x3 forall a. Semigroup a => a %1 -> a %1 -> a
<> c
y3, d
x4 forall a. Semigroup a => a %1 -> a %1 -> a
<> d
y4)

instance (Semigroup (f (g a))) => Semigroup (Functor.Compose f g a) where
  Functor.Compose f (g a)
x <> :: Compose f g a %1 -> Compose f g a %1 -> Compose f g a
<> Functor.Compose f (g a)
y = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Functor.Compose (f (g a)
x forall a. Semigroup a => a %1 -> a %1 -> a
<> f (g a)
y)

instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where
  (a
x1, b
x2, c
x3, d
x4, e
x5) <> :: (a, b, c, d, e) %1 -> (a, b, c, d, e) %1 -> (a, b, c, d, e)
<> (a
y1, b
y2, c
y3, d
y4, e
y5) = (a
x1 forall a. Semigroup a => a %1 -> a %1 -> a
<> a
y1, b
x2 forall a. Semigroup a => a %1 -> a %1 -> a
<> b
y2, c
x3 forall a. Semigroup a => a %1 -> a %1 -> a
<> c
y3, d
x4 forall a. Semigroup a => a %1 -> a %1 -> a
<> d
y4, e
x5 forall a. Semigroup a => a %1 -> a %1 -> a
<> e
y5)