{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-| 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
    import              Data.Simplifiable
    
    import          GHC.Generics
    
    -- | '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, (forall x. StarIdentity a -> Rep (StarIdentity a) x)
-> (forall x. Rep (StarIdentity a) x -> StarIdentity a)
-> Generic (StarIdentity a)
forall x. Rep (StarIdentity a) x -> StarIdentity a
forall x. StarIdentity a -> Rep (StarIdentity a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (StarIdentity a) x -> StarIdentity a
forall a x. StarIdentity a -> Rep (StarIdentity a) x
$cfrom :: forall a x. StarIdentity a -> Rep (StarIdentity a) x
from :: forall x. StarIdentity a -> Rep (StarIdentity a) x
$cto :: forall a x. Rep (StarIdentity a) x -> StarIdentity a
to :: forall x. Rep (StarIdentity a) x -> StarIdentity a
Generic, StarIdentity a -> StarIdentity a
(StarIdentity a -> StarIdentity a) -> Simplifiable (StarIdentity a)
forall a. Simplifiable a => StarIdentity a -> StarIdentity a
forall a. (a -> a) -> Simplifiable a
$csimplify :: forall a. Simplifiable a => StarIdentity a -> StarIdentity a
simplify :: StarIdentity a -> StarIdentity a
Simplifiable)
    
    instance Morphism (StarIdentity a) a where
        (StarIdentity a
x) @ :: StarIdentity a -> StarIdentity a -> StarIdentity a
@ StarIdentity a
_ = (a -> StarIdentity a
forall a. a -> StarIdentity a
StarIdentity a
x)
        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, (forall x. Galaxy a -> Rep (Galaxy a) x)
-> (forall x. Rep (Galaxy a) x -> Galaxy a) -> Generic (Galaxy a)
forall x. Rep (Galaxy a) x -> Galaxy a
forall x. Galaxy a -> Rep (Galaxy a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Galaxy a) x -> Galaxy a
forall a x. Galaxy a -> Rep (Galaxy a) x
$cfrom :: forall a x. Galaxy a -> Rep (Galaxy a) x
from :: forall x. Galaxy a -> Rep (Galaxy a) x
$cto :: forall a x. Rep (Galaxy a) x -> Galaxy a
to :: forall x. Rep (Galaxy a) x -> Galaxy a
Generic, Int -> Int -> String -> Galaxy a -> String
Int -> Galaxy a -> String
(Int -> Galaxy a -> String)
-> (Int -> Int -> String -> Galaxy a -> String)
-> (Int -> Galaxy a -> String)
-> PrettyPrint (Galaxy a)
forall a. Int -> Int -> String -> Galaxy a -> String
forall a. Int -> Galaxy a -> String
forall a.
(Int -> a -> String)
-> (Int -> Int -> String -> a -> String)
-> (Int -> a -> String)
-> PrettyPrint a
$cpprint :: forall a. Int -> Galaxy a -> String
pprint :: Int -> Galaxy a -> String
$cpprintWithIndentations :: forall a. Int -> Int -> String -> Galaxy a -> String
pprintWithIndentations :: Int -> Int -> String -> Galaxy a -> String
$cpprintIndent :: forall a. Int -> Galaxy a -> String
pprintIndent :: Int -> Galaxy a -> String
PrettyPrint, Galaxy a -> Galaxy a
(Galaxy a -> Galaxy a) -> Simplifiable (Galaxy a)
forall a. Galaxy a -> Galaxy a
forall a. (a -> a) -> Simplifiable a
$csimplify :: forall a. Galaxy a -> Galaxy a
simplify :: Galaxy a -> Galaxy a
Simplifiable)
    
    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 :: Int -> StarIdentity a -> String
pprint Int
0 StarIdentity a
_ = String
"Id"
        pprint Int
v (StarIdentity a
x) = String
"Id_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> a -> String
forall a. PrettyPrint a => Int -> a -> String
pprint (Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
x
        
        -- pprintWithIndentations 0 ov indent _ = indentation ov indent ++ "Id\n"

        -- pprintWithIndentations cv ov indent (StarIdentity x) = indentation (ov - cv) indent ++ "Id_" ++ pprint (cv-1) x ++ "\n"