{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_HADDOCK hide #-}

-- | This module provides linear versions of 'Monoid'.
--
-- To learn about how these classic monoids work, go to this school of haskell
-- [post](https://www.schoolofhaskell.com/user/mgsloan/monoids-tour).
module Data.Monoid.Linear.Internal.Monoid
  ( -- * Monoid operations
    Monoid (..),
    mconcat,
    mappend,
    -- Cannot export Data.Monoid.{First,Last} because of the name clash with Data.Semigroup.{First,Last}
  )
where

import Data.Functor.Compose (Compose (Compose))
import qualified Data.Functor.Compose as Functor
import Data.Functor.Const (Const)
import Data.Functor.Identity (Identity (Identity))
import Data.Functor.Product (Product (Pair))
import qualified Data.Functor.Product as Functor
import qualified Data.Monoid as Monoid
import Data.Monoid.Linear.Internal.Semigroup
import Data.Ord (Down (Down))
import Data.Proxy (Proxy (Proxy))
import Data.Unrestricted.Linear.Internal.Consumable (Consumable)
import GHC.Types hiding (Any)
import Prelude.Linear.Internal
import Prelude (Maybe (Nothing))
import qualified Prelude

-- | A linear monoid is a linear semigroup with an identity on the binary
-- operation.
--
-- Laws (same as 'Data.Monoid.Monoid'):
--   * ∀ x ∈ G, x <> mempty = mempty <> x = x
class Semigroup a => Monoid a where
  {-# MINIMAL mempty #-}
  mempty :: a

instance (Prelude.Semigroup a, Monoid a) => Prelude.Monoid (NonLinear a) where
  mempty :: NonLinear a
mempty = a -> NonLinear a
forall a. a -> NonLinear a
NonLinear a
forall a. Monoid a => a
mempty

-- convenience redefine

mconcat :: Monoid a => [a] %1 -> a
mconcat :: forall a. Monoid a => [a] %1 -> a
mconcat ([a]
xs' :: [a]) = a %1 -> [a] %1 -> a
go a
forall a. Monoid a => a
mempty [a]
xs'
  where
    go :: a %1 -> [a] %1 -> a
    go :: a %1 -> [a] %1 -> a
go a
acc [] = a
acc
    go a
acc (a
x : [a]
xs) = a %1 -> [a] %1 -> a
go (a
acc a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
<> a
x) [a]
xs

mappend :: Monoid a => a %1 -> a %1 -> a
mappend :: forall a. Monoid a => a %1 -> a %1 -> a
mappend = a %1 -> a %1 -> a
forall a. Semigroup a => a %1 -> a %1 -> a
(<>)

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

instance Prelude.Monoid (Endo a) where
  mempty :: Endo a
mempty = (a %1 -> a) -> Endo a
forall a. (a %1 -> a) -> Endo a
Endo a %1 -> a
forall a (q :: Multiplicity). a %q -> a
id

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

instance Monoid All where
  mempty :: All
mempty = Bool -> All
All Bool
True

instance Monoid Any where
  mempty :: Any
mempty = Bool -> Any
Any Bool
False

instance Monoid Ordering where
  mempty :: Ordering
mempty = Ordering
EQ

instance Monoid () where
  mempty :: ()
mempty = ()

instance Monoid a => Monoid (Identity a) where
  mempty :: Identity a
mempty = a -> Identity a
forall a. a -> Identity a
Identity a
forall a. Monoid a => a
mempty

instance Consumable a => Monoid (Monoid.First a) where
  mempty :: First a
mempty = Maybe a -> First a
forall a. Maybe a -> First a
Monoid.First Maybe a
forall a. Maybe a
Nothing

instance Consumable a => Monoid (Monoid.Last a) where
  mempty :: Last a
mempty = Maybe a -> Last a
forall a. Maybe a -> Last a
Monoid.Last Maybe a
forall a. Maybe a
Nothing

instance Monoid a => Monoid (Down a) where
  mempty :: Down a
mempty = a -> Down a
forall a. a -> Down a
Down a
forall a. Monoid a => a
mempty

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

instance Monoid a => Monoid (Dual a) where
  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
  mempty :: Endo a
mempty = (a %1 -> a) -> Endo a
forall a. (a %1 -> a) -> Endo a
Endo a %1 -> a
forall a (q :: Multiplicity). a %q -> a
id

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

instance Monoid a => Monoid (Maybe a) where
  mempty :: Maybe a
mempty = Maybe a
forall a. Maybe a
Nothing

-- See Data.List.Linear for instance ... => Monoid [a]
-- Cannot add instance Monoid a => Monoid (Op a b); would require Dupable b

instance Monoid (Proxy a) where
  mempty :: Proxy a
mempty = Proxy a
forall {k} (t :: k). Proxy t
Proxy

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

instance (Monoid a, Monoid b) => Monoid (a, b) where
  mempty :: (a, b)
mempty = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty)

instance Monoid a => Monoid (Const a b) where
  mempty :: Const a b
mempty = Const a b
forall a. Monoid a => a
mempty

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

instance (Monoid a, Monoid b, Monoid c) => Monoid (a, b, c) where
  mempty :: (a, b, c)
mempty = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty)

instance (Monoid (f a), Monoid (g a)) => Monoid (Functor.Product f g a) where
  mempty :: Product f g a
mempty = f a -> g a -> Product f g a
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair f a
forall a. Monoid a => a
mempty g a
forall a. Monoid a => a
mempty

instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) where
  mempty :: (a, b, c, d)
mempty = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty)

instance Monoid (f (g a)) => Monoid (Functor.Compose f g a) where
  mempty :: Compose f g a
mempty = f (g a) -> Compose f g a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose f (g a)
forall a. Monoid a => a
mempty

instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) where
  mempty :: (a, b, c, d, e)
mempty = (a
forall a. Monoid a => a
mempty, b
forall a. Monoid a => a
mempty, c
forall a. Monoid a => a
mempty, d
forall a. Monoid a => a
mempty, e
forall a. Monoid a => a
mempty)