{-# LANGUAGE CPP                  #-}
{-# LANGUAGE DeriveFunctor        #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Algebra.Pointed
    ( Pointed (..)
    , PointedMonoid (..)
    ) where

#if __GLASGOW_HASKELL__ <= 802
import Data.Semigroup (Semigroup (..))
#endif

-- | Class of pointed sets
--
class Pointed p where
    point :: p

instance Pointed (Maybe a) where
    point :: Maybe a
point = forall a. Maybe a
Nothing

-- | @Monoid@ should be a subclass of @Pointed@.
--
newtype PointedMonoid m = PointedMonoid { forall m. PointedMonoid m -> m
runPointedMonoid :: m }
    deriving (Int -> PointedMonoid m -> ShowS
forall m. Show m => Int -> PointedMonoid m -> ShowS
forall m. Show m => [PointedMonoid m] -> ShowS
forall m. Show m => PointedMonoid m -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PointedMonoid m] -> ShowS
$cshowList :: forall m. Show m => [PointedMonoid m] -> ShowS
show :: PointedMonoid m -> String
$cshow :: forall m. Show m => PointedMonoid m -> String
showsPrec :: Int -> PointedMonoid m -> ShowS
$cshowsPrec :: forall m. Show m => Int -> PointedMonoid m -> ShowS
Show, PointedMonoid m -> PointedMonoid m -> Bool
forall m. Eq m => PointedMonoid m -> PointedMonoid m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PointedMonoid m -> PointedMonoid m -> Bool
$c/= :: forall m. Eq m => PointedMonoid m -> PointedMonoid m -> Bool
== :: PointedMonoid m -> PointedMonoid m -> Bool
$c== :: forall m. Eq m => PointedMonoid m -> PointedMonoid m -> Bool
Eq, PointedMonoid m -> PointedMonoid m -> Bool
PointedMonoid m -> PointedMonoid m -> Ordering
PointedMonoid m -> PointedMonoid m -> PointedMonoid m
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {m}. Ord m => Eq (PointedMonoid m)
forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Bool
forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Ordering
forall m.
Ord m =>
PointedMonoid m -> PointedMonoid m -> PointedMonoid m
min :: PointedMonoid m -> PointedMonoid m -> PointedMonoid m
$cmin :: forall m.
Ord m =>
PointedMonoid m -> PointedMonoid m -> PointedMonoid m
max :: PointedMonoid m -> PointedMonoid m -> PointedMonoid m
$cmax :: forall m.
Ord m =>
PointedMonoid m -> PointedMonoid m -> PointedMonoid m
>= :: PointedMonoid m -> PointedMonoid m -> Bool
$c>= :: forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Bool
> :: PointedMonoid m -> PointedMonoid m -> Bool
$c> :: forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Bool
<= :: PointedMonoid m -> PointedMonoid m -> Bool
$c<= :: forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Bool
< :: PointedMonoid m -> PointedMonoid m -> Bool
$c< :: forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Bool
compare :: PointedMonoid m -> PointedMonoid m -> Ordering
$ccompare :: forall m. Ord m => PointedMonoid m -> PointedMonoid m -> Ordering
Ord, forall a b. a -> PointedMonoid b -> PointedMonoid a
forall a b. (a -> b) -> PointedMonoid a -> PointedMonoid b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PointedMonoid b -> PointedMonoid a
$c<$ :: forall a b. a -> PointedMonoid b -> PointedMonoid a
fmap :: forall a b. (a -> b) -> PointedMonoid a -> PointedMonoid b
$cfmap :: forall a b. (a -> b) -> PointedMonoid a -> PointedMonoid b
Functor)

instance Semigroup m => Semigroup (PointedMonoid m) where
    (PointedMonoid m
m) <> :: PointedMonoid m -> PointedMonoid m -> PointedMonoid m
<> (PointedMonoid m
n) = forall m. m -> PointedMonoid m
PointedMonoid (m
m forall a. Semigroup a => a -> a -> a
<> m
n)

instance Monoid m => Monoid (PointedMonoid m) where
    mempty :: PointedMonoid m
mempty = forall m. m -> PointedMonoid m
PointedMonoid forall a. Monoid a => a
mempty
#if __GLASGOW_HASKELL__ <= 802
    mappend (PointedMonoid m) (PointedMonoid n) = PointedMonoid $ mappend m n
#endif

instance Monoid m => Pointed (PointedMonoid m) where
    point :: PointedMonoid m
point = forall a. Monoid a => a
mempty