{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
module Math.Categories.Galaxy
(
StarIdentity(..),
Galaxy(..),
)
where
import Math.Category
import Math.IO.PrettyPrint
import Data.WeakSet.Safe
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
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