{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.AST.TypeCategory
( TypeCategory (IN, OUT, LEAF),
type (<=!),
type (<=?),
OUT,
IN,
ANY,
LEAF,
OBJECT,
INPUT_OBJECT,
IMPLEMENTABLE,
fromAny,
toAny,
ToCategory (..),
FromCategory (..),
ToOBJECT,
)
where
import Data.Morpheus.Types.Internal.AST.Base
( FALSE,
TRUE,
)
import Data.Morpheus.Types.Internal.AST.Stage (Stage)
import Relude
data TypeCategory
= IN
| OUT
| ANY
| LEAF
| OBJECT
| INPUT_OBJECT
| IMPLEMENTABLE
deriving (Int -> TypeCategory -> ShowS
[TypeCategory] -> ShowS
TypeCategory -> String
(Int -> TypeCategory -> ShowS)
-> (TypeCategory -> String)
-> ([TypeCategory] -> ShowS)
-> Show TypeCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeCategory] -> ShowS
$cshowList :: [TypeCategory] -> ShowS
show :: TypeCategory -> String
$cshow :: TypeCategory -> String
showsPrec :: Int -> TypeCategory -> ShowS
$cshowsPrec :: Int -> TypeCategory -> ShowS
Show, TypeCategory -> TypeCategory -> Bool
(TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool) -> Eq TypeCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeCategory -> TypeCategory -> Bool
$c/= :: TypeCategory -> TypeCategory -> Bool
== :: TypeCategory -> TypeCategory -> Bool
$c== :: TypeCategory -> TypeCategory -> Bool
Eq, Eq TypeCategory
Eq TypeCategory
-> (TypeCategory -> TypeCategory -> Ordering)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> Bool)
-> (TypeCategory -> TypeCategory -> TypeCategory)
-> (TypeCategory -> TypeCategory -> TypeCategory)
-> Ord TypeCategory
TypeCategory -> TypeCategory -> Bool
TypeCategory -> TypeCategory -> Ordering
TypeCategory -> TypeCategory -> TypeCategory
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
min :: TypeCategory -> TypeCategory -> TypeCategory
$cmin :: TypeCategory -> TypeCategory -> TypeCategory
max :: TypeCategory -> TypeCategory -> TypeCategory
$cmax :: TypeCategory -> TypeCategory -> TypeCategory
>= :: TypeCategory -> TypeCategory -> Bool
$c>= :: TypeCategory -> TypeCategory -> Bool
> :: TypeCategory -> TypeCategory -> Bool
$c> :: TypeCategory -> TypeCategory -> Bool
<= :: TypeCategory -> TypeCategory -> Bool
$c<= :: TypeCategory -> TypeCategory -> Bool
< :: TypeCategory -> TypeCategory -> Bool
$c< :: TypeCategory -> TypeCategory -> Bool
compare :: TypeCategory -> TypeCategory -> Ordering
$ccompare :: TypeCategory -> TypeCategory -> Ordering
$cp1Ord :: Eq TypeCategory
Ord)
type IN = 'IN
type OUT = 'OUT
type ANY = 'ANY
type OBJECT = 'OBJECT
type IMPLEMENTABLE = 'IMPLEMENTABLE
type LEAF = 'LEAF
type INPUT_OBJECT = 'INPUT_OBJECT
toAny ::
(ToCategory a k ANY) =>
a (k :: TypeCategory) (s :: Stage) ->
a ANY s
toAny :: a k s -> a ANY s
toAny = a k s -> a ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
ToCategory a k k' =>
a k s -> a k' s
toCategory
fromAny ::
(FromCategory a ANY k) =>
a ANY (s :: Stage) ->
Maybe (a k s)
fromAny :: a ANY s -> Maybe (a k s)
fromAny = a ANY s -> Maybe (a k s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
(k' :: TypeCategory) (s :: Stage).
FromCategory a k k' =>
a k s -> Maybe (a k' s)
fromCategory
class ToCategory a (k :: TypeCategory) (k' :: TypeCategory) where
toCategory :: a k (s :: Stage) -> a k' s
class FromCategory a (k :: TypeCategory) (k' :: TypeCategory) where
fromCategory :: a k (s :: Stage) -> Maybe (a k' s)
type (a :: TypeCategory) <=! (b :: TypeCategory) = a <=? b ~ TRUE
type family (elem :: TypeCategory) <=? (cat :: TypeCategory) :: Bool where
LEAF <=? IN = TRUE
LEAF <=? OUT = TRUE
INPUT_OBJECT <=? IN = TRUE
OBJECT <=? IMPLEMENTABLE = TRUE
OBJECT <=? OUT = TRUE
IMPLEMENTABLE <=? OUT = TRUE
ANY <=? a = TRUE
a <=? ANY = TRUE
a <=? a = TRUE
a <=? b = FALSE
type family ToOBJECT (s :: TypeCategory) :: TypeCategory where
ToOBJECT OUT = OBJECT
ToOBJECT IN = INPUT_OBJECT