{-# 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 qualified Data.Unrestricted.Linear.Internal.Ur as Ur
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 = forall a. a -> NonLinear a
NonLinear 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 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 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 = forall a. Semigroup a => a %1 -> a %1 -> a
(<>)

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

instance Prelude.Monoid (Endo a) where
  mempty :: Endo a
mempty = forall a. (a %1 -> a) -> Endo a
Endo 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 = forall a. a -> Identity a
Identity forall a. Monoid a => a
mempty

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

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

instance (Monoid a) => Monoid (Down a) where
  mempty :: Down a
mempty = forall a. a -> Down a
Down 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 = forall a. a -> Dual a
Dual forall a. Monoid a => a
mempty

instance Monoid (Endo a) where
  mempty :: Endo a
mempty = forall a. (a %1 -> a) -> Endo a
Endo 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 (Semigroup a) => Monoid (Maybe a) where
  mempty :: Maybe a
mempty = 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 = 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 = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

instance (Monoid a) => Monoid (Const a b) where
  mempty :: Const a b
mempty = 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 = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, 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 = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall a. Monoid a => a
mempty 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 = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

instance (Monoid (f (g a))) => Monoid (Functor.Compose f g a) where
  mempty :: Compose f g a
mempty = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose 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 = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

-- | Useful to treat /unrestricted/ monoids as linear ones.
instance (Prelude.Monoid a) => Monoid (Ur.Ur a) where
  mempty :: Ur a
mempty = forall a. a -> Ur a
Ur.Ur forall a. Monoid a => a
Prelude.mempty
  {-# INLINE mempty #-}