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 :: 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
<> :: m -> m -> m
(<>) = 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 :: 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 :: 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