{-# LANGUAGE NoRebindableSyntax #-}

-- | Free monoid — the initial encoding of 'Multiplicative'.
module NumHask.Free.Multiplicative
  ( Multiplicative (..),
    one,
    times,
    embed,
    lift,
    normalize,
    eval,
    foldMultiplicative,
    flatten,
  )
where

import NumHask.Algebra.Multiplicative qualified as NH
import Prelude (Eq, Show, otherwise, (==))
import Prelude qualified as P

-- | Free monoid over a carrier type.
--
-- The initial encoding of 'NumHask.Algebra.Multiplicative.Multiplicative'.
-- Terms are built from 'one', 'times', and 'embed'.
data Multiplicative a
  = One
  | Times (Multiplicative a) (Multiplicative a)
  | Embed a
  deriving (Multiplicative a -> Multiplicative a -> Bool
(Multiplicative a -> Multiplicative a -> Bool)
-> (Multiplicative a -> Multiplicative a -> Bool)
-> Eq (Multiplicative a)
forall a. Eq a => Multiplicative a -> Multiplicative a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Multiplicative a -> Multiplicative a -> Bool
== :: Multiplicative a -> Multiplicative a -> Bool
$c/= :: forall a. Eq a => Multiplicative a -> Multiplicative a -> Bool
/= :: Multiplicative a -> Multiplicative a -> Bool
Eq, Int -> Multiplicative a -> ShowS
[Multiplicative a] -> ShowS
Multiplicative a -> String
(Int -> Multiplicative a -> ShowS)
-> (Multiplicative a -> String)
-> ([Multiplicative a] -> ShowS)
-> Show (Multiplicative a)
forall a. Show a => Int -> Multiplicative a -> ShowS
forall a. Show a => [Multiplicative a] -> ShowS
forall a. Show a => Multiplicative a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Multiplicative a -> ShowS
showsPrec :: Int -> Multiplicative a -> ShowS
$cshow :: forall a. Show a => Multiplicative a -> String
show :: Multiplicative a -> String
$cshowList :: forall a. Show a => [Multiplicative a] -> ShowS
showList :: [Multiplicative a] -> ShowS
Show)

-- | Multiplicative identity.
one :: Multiplicative a
one :: forall a. Multiplicative a
one = Multiplicative a
forall a. Multiplicative a
One

-- | Multiplication with identity absorption.
--
-- > times one a = a
-- > times a one = a
times :: Multiplicative a -> Multiplicative a -> Multiplicative a
times :: forall a. Multiplicative a -> Multiplicative a -> Multiplicative a
times Multiplicative a
One Multiplicative a
b = Multiplicative a
b
times Multiplicative a
a Multiplicative a
One = Multiplicative a
a
times Multiplicative a
a Multiplicative a
b = Multiplicative a -> Multiplicative a -> Multiplicative a
forall a. Multiplicative a -> Multiplicative a -> Multiplicative a
Times Multiplicative a
a Multiplicative a
b

-- | Embed a carrier value as an atomic generator.
embed :: a -> Multiplicative a
embed :: forall a. a -> Multiplicative a
embed = a -> Multiplicative a
forall a. a -> Multiplicative a
Embed

-- $setup
-- >>> import Prelude (fromInteger)

-- | Lift a carrier value, absorbing the multiplicative identity.
--
-- >>> lift 1
-- One
lift :: (Eq a, NH.Multiplicative a) => a -> Multiplicative a
lift :: forall a. (Eq a, Multiplicative a) => a -> Multiplicative a
lift a
a
  | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Multiplicative a => a
NH.one = Multiplicative a
forall a. Multiplicative a
One
  | Bool
otherwise = a -> Multiplicative a
forall a. a -> Multiplicative a
Embed a
a

-- | Normalize a term with respect to monoid laws.
--
-- >>> normalize (embed 1)
-- One
normalize :: (Eq a, NH.Multiplicative a) => Multiplicative a -> Multiplicative a
normalize :: forall a.
(Eq a, Multiplicative a) =>
Multiplicative a -> Multiplicative a
normalize Multiplicative a
One = Multiplicative a
forall a. Multiplicative a
One
normalize (Embed a
a)
  | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Multiplicative a => a
NH.one = Multiplicative a
forall a. Multiplicative a
One
  | Bool
otherwise = a -> Multiplicative a
forall a. a -> Multiplicative a
Embed a
a
normalize (Times Multiplicative a
a Multiplicative a
b) = Multiplicative a -> Multiplicative a -> Multiplicative a
forall a. Multiplicative a -> Multiplicative a -> Multiplicative a
times (Multiplicative a -> Multiplicative a
forall a.
(Eq a, Multiplicative a) =>
Multiplicative a -> Multiplicative a
normalize Multiplicative a
a) (Multiplicative a -> Multiplicative a
forall a.
(Eq a, Multiplicative a) =>
Multiplicative a -> Multiplicative a
normalize Multiplicative a
b)

-- | Evaluate a term into any 'NumHask.Algebra.Multiplicative.Multiplicative'.
--
-- This is the unique homomorphism out of the free monoid.
eval :: (NH.Multiplicative a) => Multiplicative a -> a
eval :: forall a. Multiplicative a => Multiplicative a -> a
eval Multiplicative a
One = a
forall a. Multiplicative a => a
NH.one
eval (Times Multiplicative a
a Multiplicative a
b) = Multiplicative a -> a
forall a. Multiplicative a => Multiplicative a -> a
eval Multiplicative a
a a -> a -> a
forall a. Multiplicative a => a -> a -> a
NH.* Multiplicative a -> a
forall a. Multiplicative a => Multiplicative a -> a
eval Multiplicative a
b
eval (Embed a
a) = a
a

-- | Universal property: fold with a target monoid.
foldMultiplicative :: b -> (b -> b -> b) -> (a -> b) -> Multiplicative a -> b
foldMultiplicative :: forall b a. b -> (b -> b -> b) -> (a -> b) -> Multiplicative a -> b
foldMultiplicative b
z b -> b -> b
p a -> b
f = Multiplicative a -> b
go
  where
    go :: Multiplicative a -> b
go Multiplicative a
One = b
z
    go (Times Multiplicative a
a Multiplicative a
b) = b -> b -> b
p (Multiplicative a -> b
go Multiplicative a
a) (Multiplicative a -> b
go Multiplicative a
b)
    go (Embed a
a) = a -> b
f a
a

-- | Flatten a term to a list of embedded generators, discarding identities.
flatten :: Multiplicative a -> [a]
flatten :: forall a. Multiplicative a -> [a]
flatten = [a] -> ([a] -> [a] -> [a]) -> (a -> [a]) -> Multiplicative a -> [a]
forall b a. b -> (b -> b -> b) -> (a -> b) -> Multiplicative a -> b
foldMultiplicative [] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(P.++) (a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [])