{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.KindID.Internal where
import Data.Type.Bool
import Data.Type.Equality
import Data.Type.Ord
import Data.UUID.V7 (UUID)
import GHC.TypeLits hiding (Text)
newtype KindID (prefix :: Symbol) = KindID { forall (prefix :: Symbol). KindID prefix -> UUID
_getUUID :: UUID }
deriving (KindID prefix -> KindID prefix -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
/= :: KindID prefix -> KindID prefix -> Bool
$c/= :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
== :: KindID prefix -> KindID prefix -> Bool
$c== :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
Eq, KindID prefix -> KindID prefix -> Bool
KindID prefix -> KindID prefix -> Ordering
KindID prefix -> KindID prefix -> KindID prefix
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 (prefix :: Symbol). Eq (KindID prefix)
forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
forall (prefix :: Symbol).
KindID prefix -> KindID prefix -> Ordering
forall (prefix :: Symbol).
KindID prefix -> KindID prefix -> KindID prefix
min :: KindID prefix -> KindID prefix -> KindID prefix
$cmin :: forall (prefix :: Symbol).
KindID prefix -> KindID prefix -> KindID prefix
max :: KindID prefix -> KindID prefix -> KindID prefix
$cmax :: forall (prefix :: Symbol).
KindID prefix -> KindID prefix -> KindID prefix
>= :: KindID prefix -> KindID prefix -> Bool
$c>= :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
> :: KindID prefix -> KindID prefix -> Bool
$c> :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
<= :: KindID prefix -> KindID prefix -> Bool
$c<= :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
< :: KindID prefix -> KindID prefix -> Bool
$c< :: forall (prefix :: Symbol). KindID prefix -> KindID prefix -> Bool
compare :: KindID prefix -> KindID prefix -> Ordering
$ccompare :: forall (prefix :: Symbol).
KindID prefix -> KindID prefix -> Ordering
Ord, Int -> KindID prefix -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (prefix :: Symbol). Int -> KindID prefix -> ShowS
forall (prefix :: Symbol). [KindID prefix] -> ShowS
forall (prefix :: Symbol). KindID prefix -> String
showList :: [KindID prefix] -> ShowS
$cshowList :: forall (prefix :: Symbol). [KindID prefix] -> ShowS
show :: KindID prefix -> String
$cshow :: forall (prefix :: Symbol). KindID prefix -> String
showsPrec :: Int -> KindID prefix -> ShowS
$cshowsPrec :: forall (prefix :: Symbol). Int -> KindID prefix -> ShowS
Show)
type ValidPrefix (prefix :: Symbol) = ( KnownSymbol prefix
, LengthSymbol prefix < 64
, IsLowerSymbol prefix ~ 'True )
type family LengthSymbol (prefix :: Symbol) :: Nat where
LengthSymbol prefix = LSUH (UnconsSymbol prefix)
type family LSUH (uncons :: Maybe (Char, Symbol)) :: Nat where
LSUH 'Nothing = 0
LSUH ('Just '(c, s)) = 1 + LengthSymbol s
type family IsLowerChar (ch :: Char) :: Bool where
IsLowerChar ch = Compare '`' ch == LT && Compare ch '{' == LT
type family IsLowerSymbol (prefix :: Symbol) :: Bool where
IsLowerSymbol prefix = ILSUH (UnconsSymbol prefix)
type family ILSUH (uncons :: Maybe (Char, Symbol)) :: Bool where
ILSUH 'Nothing = 'True
ILSUH ('Just '(c, s)) = IsLowerChar c && IsLowerSymbol s