{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

{-| Module  : FiniteCategories
Description : The __'Galaxy'__ category has every objects and no morphism other than identities.
Copyright   : Guillaume Sabbagh 2022
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The __'Galaxy'__ category has every objects and no morphism other than identities.

It is called __'Galaxy'__ because its underlying graph is composed of a lot of points with no arrow between them.

It is the biggest 'DiscreteCategory'.
-}

module Math.Categories.Galaxy
(
    StarIdentity(..),
    Galaxy(..),   
)
where
    import          Math.Category
    import          Math.IO.PrettyPrint
    
    import          Data.WeakSet.Safe
    
    -- | 'StarIdentity' is the identity of a star (an object) in a 'Galaxy'.

    data StarIdentity a = StarIdentity a deriving (StarIdentity a -> StarIdentity a -> Bool
(StarIdentity a -> StarIdentity a -> Bool)
-> (StarIdentity a -> StarIdentity a -> Bool)
-> Eq (StarIdentity a)
forall a. Eq a => StarIdentity a -> StarIdentity a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => StarIdentity a -> StarIdentity a -> Bool
== :: StarIdentity a -> StarIdentity a -> Bool
$c/= :: forall a. Eq a => StarIdentity a -> StarIdentity a -> Bool
/= :: StarIdentity a -> StarIdentity a -> Bool
Eq, Int -> StarIdentity a -> ShowS
[StarIdentity a] -> ShowS
StarIdentity a -> String
(Int -> StarIdentity a -> ShowS)
-> (StarIdentity a -> String)
-> ([StarIdentity a] -> ShowS)
-> Show (StarIdentity a)
forall a. Show a => Int -> StarIdentity a -> ShowS
forall a. Show a => [StarIdentity a] -> ShowS
forall a. Show a => StarIdentity a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> StarIdentity a -> ShowS
showsPrec :: Int -> StarIdentity a -> ShowS
$cshow :: forall a. Show a => StarIdentity a -> String
show :: StarIdentity a -> String
$cshowList :: forall a. Show a => [StarIdentity a] -> ShowS
showList :: [StarIdentity a] -> ShowS
Show)
    
    instance (Eq a) => Morphism (StarIdentity a) a where
        (StarIdentity a
x) @? :: StarIdentity a -> StarIdentity a -> Maybe (StarIdentity a)
@? (StarIdentity a
y)
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = StarIdentity a -> Maybe (StarIdentity a)
forall a. a -> Maybe a
Just (a -> StarIdentity a
forall a. a -> StarIdentity a
StarIdentity a
x)
            | Bool
otherwise = Maybe (StarIdentity a)
forall a. Maybe a
Nothing
        source :: StarIdentity a -> a
source (StarIdentity a
x) = a
x
        target :: StarIdentity a -> a
target = StarIdentity a -> a
forall m o. Morphism m o => m -> o
source
    
    -- | The __'Galaxy'__ category has every objects and no morphism other than identities.

    data Galaxy a = Galaxy deriving (Galaxy a -> Galaxy a -> Bool
(Galaxy a -> Galaxy a -> Bool)
-> (Galaxy a -> Galaxy a -> Bool) -> Eq (Galaxy a)
forall a. Galaxy a -> Galaxy a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Galaxy a -> Galaxy a -> Bool
== :: Galaxy a -> Galaxy a -> Bool
$c/= :: forall a. Galaxy a -> Galaxy a -> Bool
/= :: Galaxy a -> Galaxy a -> Bool
Eq,Int -> Galaxy a -> ShowS
[Galaxy a] -> ShowS
Galaxy a -> String
(Int -> Galaxy a -> ShowS)
-> (Galaxy a -> String) -> ([Galaxy a] -> ShowS) -> Show (Galaxy a)
forall a. Int -> Galaxy a -> ShowS
forall a. [Galaxy a] -> ShowS
forall a. Galaxy a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Galaxy a -> ShowS
showsPrec :: Int -> Galaxy a -> ShowS
$cshow :: forall a. Galaxy a -> String
show :: Galaxy a -> String
$cshowList :: forall a. [Galaxy a] -> ShowS
showList :: [Galaxy a] -> ShowS
Show)
    
    instance (Eq a) => Category (Galaxy a) (StarIdentity a) a where
        identity :: Morphism (StarIdentity a) a => Galaxy a -> a -> StarIdentity a
identity Galaxy a
_ = a -> StarIdentity a
forall a. a -> StarIdentity a
StarIdentity
        ar :: Morphism (StarIdentity a) a =>
Galaxy a -> a -> a -> Set (StarIdentity a)
ar Galaxy a
_ a
x a
y
            | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [StarIdentity a] -> Set (StarIdentity a)
forall a. [a] -> Set a
set [a -> StarIdentity a
forall a. a -> StarIdentity a
StarIdentity a
x]
            | Bool
otherwise = [StarIdentity a] -> Set (StarIdentity a)
forall a. [a] -> Set a
set []
    
    instance (PrettyPrint a) => PrettyPrint (StarIdentity a) where
        pprint :: StarIdentity a -> String
pprint (StarIdentity a
x) = String
"Id"String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. PrettyPrint a => a -> String
pprint a
x
    
    instance PrettyPrint (Galaxy a) where
        pprint :: Galaxy a -> String
pprint = Galaxy a -> String
forall a. Show a => a -> String
show