content: {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE PolyKinds #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  -- | Auxilary definitions for 'Semigroup'
  --
  -- This module provides some @newtype@ wrappers and helpers which are
  -- reexported from the "Data.Semigroup" module or imported directly
  -- by some other modules.
  --
  -- This module also provides internal definitions related to the
  -- 'Semigroup' class some.
  --
  -- This module exists mostly to simplify or workaround import-graph
  -- issues; there is also a .hs-boot file to allow "GHC.Base" and other
  -- modules to import method default implementations for 'stimes'
  --
  -- @since 4.11.0.0
  module Data.Semigroup.Internal where
  
  import GHC.Base hiding (Any)
  import GHC.Enum
  import GHC.Num
  import GHC.Read
  import GHC.Show
  import GHC.Generics
  import GHC.Real
  
  -- | This is a valid definition of 'stimes' for an idempotent 'Semigroup'.
  --
  -- When @x <> x = x@, this definition should be preferred, because it
  -- works in /O(1)/ rather than /O(log n)/.
  stimesIdempotent :: Integral b => b -> a -> a
  stimesIdempotent n x
    | n <= 0 = errorWithoutStackTrace "stimesIdempotent: positive multiplier expected"
    | otherwise = x
  
  -- | This is a valid definition of 'stimes' for an idempotent 'Monoid'.
  --
  -- When @mappend x x = x@, this definition should be preferred, because it
  -- works in /O(1)/ rather than /O(log n)/
  stimesIdempotentMonoid :: (Integral b, Monoid a) => b -> a -> a
  stimesIdempotentMonoid n x = case compare n 0 of
    LT -> errorWithoutStackTrace "stimesIdempotentMonoid: negative multiplier"
    EQ -> mempty
    GT -> x
  
  -- | This is a valid definition of 'stimes' for a 'Monoid'.
  --
  -- Unlike the default definition of 'stimes', it is defined for 0
  -- and so it should be preferred where possible.
  stimesMonoid :: (Integral b, Monoid a) => b -> a -> a
  stimesMonoid n x0 = case compare n 0 of
    LT -> errorWithoutStackTrace "stimesMonoid: negative multiplier"
    EQ -> mempty
    GT -> f x0 n
      where
        f x y
          | even y = f (x `mappend` x) (y `quot` 2)
          | y == 1 = x
          | otherwise = g (x `mappend` x) (y `quot` 2) x               -- See Note [Half of y - 1]
        g x y z
          | even y = g (x `mappend` x) (y `quot` 2) z
          | y == 1 = x `mappend` z
          | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z) -- See Note [Half of y - 1]
  
  -- this is used by the class definitionin GHC.Base;
  -- it lives here to avoid cycles
  stimesDefault :: (Integral b, Semigroup a) => b -> a -> a
  stimesDefault y0 x0
    | y0 <= 0   = errorWithoutStackTrace "stimes: positive multiplier expected"
    | otherwise = f x0 y0
    where
      f x y
        | even y = f (x <> x) (y `quot` 2)
        | y == 1 = x
        | otherwise = g (x <> x) (y `quot` 2) x        -- See Note [Half of y - 1]
      g x y z
        | even y = g (x <> x) (y `quot` 2) z
        | y == 1 = x <> z
        | otherwise = g (x <> x) (y `quot` 2) (x <> z) -- See Note [Half of y - 1]
  
  {- Note [Half of y - 1]
     ~~~~~~~~~~~~~~~~~~~~~
     Since y is guaranteed to be odd and positive here,
     half of y - 1 can be computed as y `quot` 2, optimising subtraction away.
  -}
  
  stimesMaybe :: (Integral b, Semigroup a) => b -> Maybe a -> Maybe a
  stimesMaybe _ Nothing = Nothing
  stimesMaybe n (Just a) = case compare n 0 of
      LT -> errorWithoutStackTrace "stimes: Maybe, negative multiplier"
      EQ -> Nothing
      GT -> Just (stimes n a)
  
  stimesList  :: Integral b => b -> [a] -> [a]
  stimesList n x
    | n < 0 = errorWithoutStackTrace "stimes: [], negative multiplier"
    | otherwise = rep n
    where
      rep 0 = []
      rep i = x ++ rep (i - 1)
  
  -- | The dual of a 'Monoid', obtained by swapping the arguments of 'mappend'.
  --
  -- >>> getDual (mappend (Dual "Hello") (Dual "World"))
  -- "WorldHello"
  newtype Dual a = Dual { getDual :: a }
          deriving ( Eq       -- ^ @since 2.01
                   , Ord      -- ^ @since 2.01
                   , Read     -- ^ @since 2.01
                   , Show     -- ^ @since 2.01
                   , Bounded  -- ^ @since 2.01
                   , Generic  -- ^ @since 4.7.0.0
                   , Generic1 -- ^ @since 4.7.0.0
                   )
  
  -- | @since 4.9.0.0
  instance Semigroup a => Semigroup (Dual a) where
          Dual a <> Dual b = Dual (b <> a)
          stimes n (Dual a) = Dual (stimes n a)
  
  -- | @since 2.01
  instance Monoid a => Monoid (Dual a) where
          mempty = Dual mempty
  
  -- | @since 4.8.0.0
  instance Functor Dual where
      fmap     = coerce
  
  -- | @since 4.8.0.0
  instance Applicative Dual where
      pure     = Dual
      (<*>)    = coerce
  
  -- | @since 4.8.0.0
  instance Monad Dual where
      m >>= k  = k (getDual m)
  
  -- | The monoid of endomorphisms under composition.
  --
  -- >>> let computation = Endo ("Hello, " ++) <> Endo (++ "!")
  -- >>> appEndo computation "Haskell"
  -- "Hello, Haskell!"
  newtype Endo a = Endo { appEndo :: a -> a }
                 deriving ( Generic -- ^ @since 4.7.0.0
                          )
  
  -- | @since 4.9.0.0
  instance Semigroup (Endo a) where
          (<>) = coerce ((.) :: (a -> a) -> (a -> a) -> (a -> a))
          stimes = stimesMonoid
  
  -- | @since 2.01
  instance Monoid (Endo a) where
          mempty = Endo id
  
  -- | Boolean monoid under conjunction ('&&').
  --
  -- >>> getAll (All True <> mempty <> All False)
  -- False
  --
  -- >>> getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
  -- False
  newtype All = All { getAll :: Bool }
          deriving ( Eq      -- ^ @since 2.01
                   , Ord     -- ^ @since 2.01
                   , Read    -- ^ @since 2.01
                   , Show    -- ^ @since 2.01
                   , Bounded -- ^ @since 2.01
                   , Generic -- ^ @since 4.7.0.0
                   )
  
  -- | @since 4.9.0.0
  instance Semigroup All where
          (<>) = coerce (&&)
          stimes = stimesIdempotentMonoid
  
  -- | @since 2.01
  instance Monoid All where
          mempty = All True
  
  -- | Boolean monoid under disjunction ('||').
  --
  -- >>> getAny (Any True <> mempty <> Any False)
  -- True
  --
  -- >>> getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
  -- True
  newtype Any = Any { getAny :: Bool }
          deriving ( Eq      -- ^ @since 2.01
                   , Ord     -- ^ @since 2.01
                   , Read    -- ^ @since 2.01
                   , Show    -- ^ @since 2.01
                   , Bounded -- ^ @since 2.01
                   , Generic -- ^ @since 4.7.0.0
                   )
  
  -- | @since 4.9.0.0
  instance Semigroup Any where
          (<>) = coerce (||)
          stimes = stimesIdempotentMonoid
  
  -- | @since 2.01
  instance Monoid Any where
          mempty = Any False
  
  -- | Monoid under addition.
  --
  -- >>> getSum (Sum 1 <> Sum 2 <> mempty)
  -- 3
  newtype Sum a = Sum { getSum :: a }
          deriving ( Eq       -- ^ @since 2.01
                   , Ord      -- ^ @since 2.01
                   , Read     -- ^ @since 2.01
                   , Show     -- ^ @since 2.01
                   , Bounded  -- ^ @since 2.01
                   , Generic  -- ^ @since 4.7.0.0
                   , Generic1 -- ^ @since 4.7.0.0
                   , Num      -- ^ @since 4.7.0.0
                   )
  
  -- | @since 4.9.0.0
  instance Num a => Semigroup (Sum a) where
          (<>) = coerce ((+) :: a -> a -> a)
          stimes n (Sum a) = Sum (fromIntegral n * a)
  
  -- | @since 2.01
  instance Num a => Monoid (Sum a) where
          mempty = Sum 0
  
  -- | @since 4.8.0.0
  instance Functor Sum where
      fmap     = coerce
  
  -- | @since 4.8.0.0
  instance Applicative Sum where
      pure     = Sum
      (<*>)    = coerce
  
  -- | @since 4.8.0.0
  instance Monad Sum where
      m >>= k  = k (getSum m)
  
  -- | Monoid under multiplication.
  --
  -- >>> getProduct (Product 3 <> Product 4 <> mempty)
  -- 12
  newtype Product a = Product { getProduct :: a }
          deriving ( Eq       -- ^ @since 2.01
                   , Ord      -- ^ @since 2.01
                   , Read     -- ^ @since 2.01
                   , Show     -- ^ @since 2.01
                   , Bounded  -- ^ @since 2.01
                   , Generic  -- ^ @since 4.7.0.0
                   , Generic1 -- ^ @since 4.7.0.0
                   , Num      -- ^ @since 4.7.0.0
                   )
  
  -- | @since 4.9.0.0
  instance Num a => Semigroup (Product a) where
          (<>) = coerce ((*) :: a -> a -> a)
          stimes n (Product a) = Product (a ^ n)
  
  
  -- | @since 2.01
  instance Num a => Monoid (Product a) where
          mempty = Product 1
  
  -- | @since 4.8.0.0
  instance Functor Product where
      fmap     = coerce
  
  -- | @since 4.8.0.0
  instance Applicative Product where
      pure     = Product
      (<*>)    = coerce
  
  -- | @since 4.8.0.0
  instance Monad Product where
      m >>= k  = k (getProduct m)
  
  
  -- | Monoid under '<|>'.
  --
  -- @since 4.8.0.0
  newtype Alt f a = Alt {getAlt :: f a}
    deriving ( Generic     -- ^ @since 4.8.0.0
             , Generic1    -- ^ @since 4.8.0.0
             , Read        -- ^ @since 4.8.0.0
             , Show        -- ^ @since 4.8.0.0
             , Eq          -- ^ @since 4.8.0.0
             , Ord         -- ^ @since 4.8.0.0
             , Num         -- ^ @since 4.8.0.0
             , Enum        -- ^ @since 4.8.0.0
             , Monad       -- ^ @since 4.8.0.0
             , MonadPlus   -- ^ @since 4.8.0.0
             , Applicative -- ^ @since 4.8.0.0
             , Alternative -- ^ @since 4.8.0.0
             , Functor     -- ^ @since 4.8.0.0
             )
  
  -- | @since 4.9.0.0
  instance Alternative f => Semigroup (Alt f a) where
      (<>) = coerce ((<|>) :: f a -> f a -> f a)
      stimes = stimesMonoid
  
  -- | @since 4.8.0.0
  instance Alternative f => Monoid (Alt f a) where
      mempty = Alt empty
  