{-# LANGUAGE NoImplicitPrelude #-}

-----------------------------------------------------------------------------
-- |
-- A class for *-semirings (pron. "star-semirings").
--
-----------------------------------------------------------------------------
module Data.Star
  ( Star(..)
  ) where

import Data.Bool (Bool(..))
import Data.Function (id, (.), const)
import Data.Proxy (Proxy(..))
import Data.Semiring

-- | A <https://en.wikipedia.org/wiki/Semiring#Star_semirings Star semiring>
-- adds one operation, 'star' to a 'Semiring', such that it follows the
-- law:
--
-- @'star' x = 'one' '+' x '*' 'star' x = 'one' '+' 'star' x '*' x@
--
-- Another operation, 'aplus', can be defined in terms of 'star':
--
-- @'aplus' x = x '*' 'star' x@
class (Semiring a) => Star a where
  {-# MINIMAL star | aplus #-}
  star :: a -> a
  star a
a = a
forall a. Semiring a => a
one a -> a -> a
forall a. Semiring a => a -> a -> a
`plus` a -> a
forall a. Star a => a -> a
aplus a
a

  aplus :: a -> a
  aplus a
a = a
a a -> a -> a
forall a. Semiring a => a -> a -> a
`times` a -> a
forall a. Star a => a -> a
star a
a

instance Star b => Star (a -> b) where
  star :: (a -> b) -> a -> b
star  = (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. Star a => a -> a
star
  aplus :: (a -> b) -> a -> b
aplus = (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) b -> b
forall a. Star a => a -> a
aplus
  {-# INLINE star #-}
  {-# INLINE aplus #-}

instance Star Bool where
  star :: Bool -> Bool
star Bool
_  = Bool
True
  aplus :: Bool -> Bool
aplus   = Bool -> Bool
forall a. a -> a
id
  {-# INLINE star #-}
  {-# INLINE aplus #-}

instance Star () where
  star :: () -> ()
star  ()
_ = ()
  aplus :: () -> ()
aplus ()
_ = ()
  {-# INLINE star #-}
  {-# INLINE aplus #-}

instance Star (Proxy a) where
  star :: Proxy a -> Proxy a
star Proxy a
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy
  aplus :: Proxy a -> Proxy a
aplus Proxy a
_ = Proxy a
forall {k} (t :: k). Proxy t
Proxy
  {-# INLINE star #-}
  {-# INLINE aplus #-}

instance Star Mod2 where
  star :: Mod2 -> Mod2
star = Mod2 -> Mod2 -> Mod2
forall a b. a -> b -> a
const Mod2
forall a. Semiring a => a
one