    module Data.Monoid.HT (cycle, (<>), when, power) where

    import Data.Monoid (Monoid, mappend, mempty, )
    import Data.Function (fix, )

    import Prelude (Integer, Bool, Ordering(..), compare, divMod, error)

    {- $setup
    >>> import qualified Test.QuickCheck as QC
    >>> import Control.Monad (mfilter)
    >>> import Data.Function.HT (powerAssociative)
    >>> import Data.Monoid (mconcat, mappend, mempty)
    -}

    {- |
    Generalization of 'Data.List.cycle' to any monoid.
    -}
    cycle :: Monoid m => m -> m
    cycle :: forall m. Monoid m => m -> m
    cycle m
    x =
       (m -> m) -> m
    forall a. (a -> a) -> a
    fix (m -> m -> m
    forall a. Monoid a => a -> a -> a
    mappend m
    x)

    infixr 6 <>

    {- |
    Infix synonym for 'mappend'.
    -}
    (<>) :: Monoid m => m -> m -> m
    <> :: forall a. Monoid a => a -> a -> a
    (<>) = m -> m -> m
    forall a. Monoid a => a -> a -> a
    mappend

    {- |
    prop> \b m -> when b m == mfilter (const b) (m::Maybe Ordering)
    prop> \b m -> when b m == mfilter (const b) (m::String)
    -}
    when :: Monoid m => Bool -> m -> m
    when :: forall m. Monoid m => Bool -> m -> m
    when Bool
    b m
    m = if Bool
    b then m
    m else m
    forall a. Monoid a => a
    mempty

    {- |
    prop> QC.forAll (QC.choose (0,20)) $ \k xs -> power (fromIntegral k) xs == mconcat (replicate k (xs::String))

    In contrast to 'powerAssociative' the 'power' function
    uses 'mempty' only for the zeroth power.

    prop> QC.forAll (QC.choose (0,20)) $ \k xs -> power k xs == powerAssociative mappend mempty (xs::String) k
    -}
    power :: Monoid m => Integer -> m -> m
    power :: forall m. Monoid m => Integer -> m -> m
    power Integer
    k m
    m =
       case Integer -> Integer -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Integer
    k Integer
    0 of
          Ordering
    LT -> [Char] -> m
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Monoid.power: negative exponent"
          Ordering
    EQ -> m
    forall a. Monoid a => a
    mempty
          Ordering
    GT ->
             let (Integer
    k2,Integer
    r) = Integer -> Integer -> (Integer, Integer)
    forall a. Integral a => a -> a -> (a, a)
    divMod Integer
    k Integer
    2
                 p :: m
    p = Integer -> m -> m
    forall m. Monoid m => Integer -> m -> m
    power Integer
    k2 m
    m
                 p2 :: m
    p2 = m
    pm -> m -> m
    forall a. Monoid a => a -> a -> a
    <>m
    p
             in case Integer
    r of
                   Integer
    0 -> m
    p2
                   Integer
    _ -> m
    mm -> m -> m
    forall a. Monoid a => a -> a -> a
    <>m
    p2