content: {-# LANGUAGE Trustworthy #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE AutoDeriveTypeable #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  Data.Monoid
  -- Copyright   :  (c) Andy Gill 2001,
  --                (c) Oregon Graduate Institute of Science and Technology, 2001
  -- License     :  BSD-style (see the file libraries/base/LICENSE)
  --
  -- Maintainer  :  libraries@haskell.org
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- A class for monoids (types with an associative binary operation that
  -- has an identity) with various general-purpose instances.
  --
  -----------------------------------------------------------------------------
  
  module Data.Monoid (
          -- * 'Monoid' typeclass
          Monoid(..),
          (<>),
          Dual(..),
          Endo(..),
          -- * 'Bool' wrappers
          All(..),
          Any(..),
          -- * 'Num' wrappers
          Sum(..),
          Product(..),
          -- * 'Maybe' wrappers
          -- $MaybeExamples
          First(..),
          Last(..),
          -- * 'Alternative' wrapper
          Alt (..)
    ) where
  
  -- Push down the module in the dependency hierarchy.
  import GHC.Base hiding (Any)
  import GHC.Enum
  import GHC.Num
  import GHC.Read
  import GHC.Show
  import GHC.Generics
  
  {-
  -- just for testing
  import Data.Maybe
  import Test.QuickCheck
  -- -}
  
  infixr 6 <>
  
  -- | An infix synonym for 'mappend'.
  --
  -- @since 4.5.0.0
  (<>) :: Monoid m => m -> m -> m
  (<>) = mappend
  {-# INLINE (<>) #-}
  
  -- Monoid instances.
  
  -- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
  newtype Dual a = Dual { getDual :: a }
          deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1)
  
  instance Monoid a => Monoid (Dual a) where
          mempty = Dual mempty
          Dual x `mappend` Dual y = Dual (y `mappend` x)
  
  -- | The monoid of endomorphisms under composition.
  newtype Endo a = Endo { appEndo :: a -> a }
                 deriving (Generic)
  
  instance Monoid (Endo a) where
          mempty = Endo id
          Endo f `mappend` Endo g = Endo (f . g)
  
  -- | Boolean monoid under conjunction ('&&').
  newtype All = All { getAll :: Bool }
          deriving (Eq, Ord, Read, Show, Bounded, Generic)
  
  instance Monoid All where
          mempty = All True
          All x `mappend` All y = All (x && y)
  
  -- | Boolean monoid under disjunction ('||').
  newtype Any = Any { getAny :: Bool }
          deriving (Eq, Ord, Read, Show, Bounded, Generic)
  
  instance Monoid Any where
          mempty = Any False
          Any x `mappend` Any y = Any (x || y)
  
  -- | Monoid under addition.
  newtype Sum a = Sum { getSum :: a }
          deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
  
  instance Num a => Monoid (Sum a) where
          mempty = Sum 0
          mappend = coerce ((+) :: a -> a -> a)
  --        Sum x `mappend` Sum y = Sum (x + y)
  
  -- | Monoid under multiplication.
  newtype Product a = Product { getProduct :: a }
          deriving (Eq, Ord, Read, Show, Bounded, Generic, Generic1, Num)
  
  instance Num a => Monoid (Product a) where
          mempty = Product 1
          mappend = coerce ((*) :: a -> a -> a)
  --        Product x `mappend` Product y = Product (x * y)
  
  -- $MaybeExamples
  -- To implement @find@ or @findLast@ on any 'Foldable':
  --
  -- @
  -- findLast :: Foldable t => (a -> Bool) -> t a -> Maybe a
  -- findLast pred = getLast . foldMap (\x -> if pred x
  --                                            then Last (Just x)
  --                                            else Last Nothing)
  -- @
  --
  -- Much of Data.Map's interface can be implemented with
  -- Data.Map.alter. Some of the rest can be implemented with a new
  -- @alterA@ function and either 'First' or 'Last':
  --
  -- > alterA :: (Applicative f, Ord k) =>
  -- >           (Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
  -- >
  -- > instance Monoid a => Applicative ((,) a)  -- from Control.Applicative
  --
  -- @
  -- insertLookupWithKey :: Ord k => (k -> v -> v -> v) -> k -> v
  --                     -> Map k v -> (Maybe v, Map k v)
  -- insertLookupWithKey combine key value =
  --   Arrow.first getFirst . alterA doChange key
  --   where
  --   doChange Nothing = (First Nothing, Just value)
  --   doChange (Just oldValue) =
  --     (First (Just oldValue),
  --      Just (combine key value oldValue))
  -- @
  
  
  -- | Maybe monoid returning the leftmost non-Nothing value.
  --
  -- @'First' a@ is isomorphic to @'Alt' 'Maybe' a@, but precedes it
  -- historically.
  newtype First a = First { getFirst :: Maybe a }
          deriving (Eq, Ord, Read, Show, Generic, Generic1,
                    Functor, Applicative, Monad)
  
  instance Monoid (First a) where
          mempty = First Nothing
          First Nothing `mappend` r = r
          l `mappend` _             = l
  
  -- | Maybe monoid returning the rightmost non-Nothing value.
  --
  -- @'Last' a@ is isomorphic to @'Dual' ('First' a)@, and thus to
  -- @'Dual' ('Alt' 'Maybe' a)@
  newtype Last a = Last { getLast :: Maybe a }
          deriving (Eq, Ord, Read, Show, Generic, Generic1,
                    Functor, Applicative, Monad)
  
  instance Monoid (Last a) where
          mempty = Last Nothing
          l `mappend` Last Nothing = l
          _ `mappend` r            = r
  
  -- | Monoid under '<|>'.
  --
  -- @since 4.8.0.0
  newtype Alt f a = Alt {getAlt :: f a}
    deriving (Generic, Generic1, Read, Show, Eq, Ord, Num, Enum,
              Monad, MonadPlus, Applicative, Alternative, Functor)
  
  instance forall f a . Alternative f => Monoid (Alt f a) where
          mempty = Alt empty
          mappend = coerce ((<|>) :: f a -> f a -> f a)
  
  {-
  {--------------------------------------------------------------------
    Testing
  --------------------------------------------------------------------}
  instance Arbitrary a => Arbitrary (Maybe a) where
    arbitrary = oneof [return Nothing, Just `fmap` arbitrary]
  
  prop_mconcatMaybe :: [Maybe [Int]] -> Bool
  prop_mconcatMaybe x =
    fromMaybe [] (mconcat x) == mconcat (catMaybes x)
  
  prop_mconcatFirst :: [Maybe Int] -> Bool
  prop_mconcatFirst x =
    getFirst (mconcat (map First x)) == listToMaybe (catMaybes x)
  prop_mconcatLast :: [Maybe Int] -> Bool
  prop_mconcatLast x =
    getLast (mconcat (map Last x)) == listLastToMaybe (catMaybes x)
          where listLastToMaybe [] = Nothing
                listLastToMaybe lst = Just (last lst)
  -- -}
  
  