{-# LANGUAGE OverloadedStrings #-}
module Type.Reflection.Name (
Unqualified(..), getUnqualified, showUnqualified,
Qualified(..), getQualified, showQualified,
PackageQualified(..), getPackageQualified, showPackageQualified,
TypeText(..), defaultRenderTypeRep,
) where
import Data.String ( IsString(..) )
import Data.Hashable ( Hashable )
import Data.Text ( Text )
import Type.Reflection
class (IsString tt, Monoid tt, Ord tt) => TypeText tt where
renderTyCon :: TyCon -> tt
renderTypeRep :: TypeRep t -> tt
renderTypeRep = forall {k} tn (outer_t :: k). TypeText tn => TypeRep outer_t -> tn
defaultRenderTypeRep
{-# MINIMAL renderTyCon #-}
newtype Unqualified = MkUnqualified Text
deriving (Unqualified -> Unqualified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unqualified -> Unqualified -> Bool
$c/= :: Unqualified -> Unqualified -> Bool
== :: Unqualified -> Unqualified -> Bool
$c== :: Unqualified -> Unqualified -> Bool
Eq, Eq Unqualified
Unqualified -> Unqualified -> Bool
Unqualified -> Unqualified -> Ordering
Unqualified -> Unqualified -> Unqualified
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 :: Unqualified -> Unqualified -> Unqualified
$cmin :: Unqualified -> Unqualified -> Unqualified
max :: Unqualified -> Unqualified -> Unqualified
$cmax :: Unqualified -> Unqualified -> Unqualified
>= :: Unqualified -> Unqualified -> Bool
$c>= :: Unqualified -> Unqualified -> Bool
> :: Unqualified -> Unqualified -> Bool
$c> :: Unqualified -> Unqualified -> Bool
<= :: Unqualified -> Unqualified -> Bool
$c<= :: Unqualified -> Unqualified -> Bool
< :: Unqualified -> Unqualified -> Bool
$c< :: Unqualified -> Unqualified -> Bool
compare :: Unqualified -> Unqualified -> Ordering
$ccompare :: Unqualified -> Unqualified -> Ordering
Ord, Int -> Unqualified -> ShowS
[Unqualified] -> ShowS
Unqualified -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unqualified] -> ShowS
$cshowList :: [Unqualified] -> ShowS
show :: Unqualified -> String
$cshow :: Unqualified -> String
showsPrec :: Int -> Unqualified -> ShowS
$cshowsPrec :: Int -> Unqualified -> ShowS
Show, Eq Unqualified
Int -> Unqualified -> Int
Unqualified -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Unqualified -> Int
$chash :: Unqualified -> Int
hashWithSalt :: Int -> Unqualified -> Int
$chashWithSalt :: Int -> Unqualified -> Int
Hashable, NonEmpty Unqualified -> Unqualified
Unqualified -> Unqualified -> Unqualified
forall b. Integral b => b -> Unqualified -> Unqualified
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Unqualified -> Unqualified
$cstimes :: forall b. Integral b => b -> Unqualified -> Unqualified
sconcat :: NonEmpty Unqualified -> Unqualified
$csconcat :: NonEmpty Unqualified -> Unqualified
<> :: Unqualified -> Unqualified -> Unqualified
$c<> :: Unqualified -> Unqualified -> Unqualified
Semigroup, Semigroup Unqualified
Unqualified
[Unqualified] -> Unqualified
Unqualified -> Unqualified -> Unqualified
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Unqualified] -> Unqualified
$cmconcat :: [Unqualified] -> Unqualified
mappend :: Unqualified -> Unqualified -> Unqualified
$cmappend :: Unqualified -> Unqualified -> Unqualified
mempty :: Unqualified
$cmempty :: Unqualified
Monoid, String -> Unqualified
forall a. (String -> a) -> IsString a
fromString :: String -> Unqualified
$cfromString :: String -> Unqualified
IsString)
instance TypeText Unqualified where
renderTyCon :: TyCon -> Unqualified
renderTyCon = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
tyConName
getUnqualified :: Unqualified -> Text
getUnqualified :: Unqualified -> Text
getUnqualified (MkUnqualified Text
str) = Text
str
showUnqualified :: TypeRep t -> Unqualified
showUnqualified :: forall {k} (t :: k). TypeRep t -> Unqualified
showUnqualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep
newtype Qualified = MkQualified Text
deriving (Qualified -> Qualified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qualified -> Qualified -> Bool
$c/= :: Qualified -> Qualified -> Bool
== :: Qualified -> Qualified -> Bool
$c== :: Qualified -> Qualified -> Bool
Eq, Eq Qualified
Qualified -> Qualified -> Bool
Qualified -> Qualified -> Ordering
Qualified -> Qualified -> Qualified
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 :: Qualified -> Qualified -> Qualified
$cmin :: Qualified -> Qualified -> Qualified
max :: Qualified -> Qualified -> Qualified
$cmax :: Qualified -> Qualified -> Qualified
>= :: Qualified -> Qualified -> Bool
$c>= :: Qualified -> Qualified -> Bool
> :: Qualified -> Qualified -> Bool
$c> :: Qualified -> Qualified -> Bool
<= :: Qualified -> Qualified -> Bool
$c<= :: Qualified -> Qualified -> Bool
< :: Qualified -> Qualified -> Bool
$c< :: Qualified -> Qualified -> Bool
compare :: Qualified -> Qualified -> Ordering
$ccompare :: Qualified -> Qualified -> Ordering
Ord, Int -> Qualified -> ShowS
[Qualified] -> ShowS
Qualified -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qualified] -> ShowS
$cshowList :: [Qualified] -> ShowS
show :: Qualified -> String
$cshow :: Qualified -> String
showsPrec :: Int -> Qualified -> ShowS
$cshowsPrec :: Int -> Qualified -> ShowS
Show, Eq Qualified
Int -> Qualified -> Int
Qualified -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Qualified -> Int
$chash :: Qualified -> Int
hashWithSalt :: Int -> Qualified -> Int
$chashWithSalt :: Int -> Qualified -> Int
Hashable, NonEmpty Qualified -> Qualified
Qualified -> Qualified -> Qualified
forall b. Integral b => b -> Qualified -> Qualified
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Qualified -> Qualified
$cstimes :: forall b. Integral b => b -> Qualified -> Qualified
sconcat :: NonEmpty Qualified -> Qualified
$csconcat :: NonEmpty Qualified -> Qualified
<> :: Qualified -> Qualified -> Qualified
$c<> :: Qualified -> Qualified -> Qualified
Semigroup, Semigroup Qualified
Qualified
[Qualified] -> Qualified
Qualified -> Qualified -> Qualified
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Qualified] -> Qualified
$cmconcat :: [Qualified] -> Qualified
mappend :: Qualified -> Qualified -> Qualified
$cmappend :: Qualified -> Qualified -> Qualified
mempty :: Qualified
$cmempty :: Qualified
Monoid, String -> Qualified
forall a. (String -> a) -> IsString a
fromString :: String -> Qualified
$cfromString :: String -> Qualified
IsString)
instance TypeText Qualified where
renderTyCon :: TyCon -> Qualified
renderTyCon TyCon
tc = forall a. IsString a => String -> a
fromString (TyCon -> String
tyConModule TyCon
tc) forall a. Semigroup a => a -> a -> a
<> Qualified
"." forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (TyCon -> String
tyConName TyCon
tc)
getQualified :: Qualified -> Text
getQualified :: Qualified -> Text
getQualified (MkQualified Text
str) = Text
str
showQualified :: TypeRep t -> Qualified
showQualified :: forall {k} (t :: k). TypeRep t -> Qualified
showQualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep
newtype PackageQualified = MkPackageQualified Text
deriving (PackageQualified -> PackageQualified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageQualified -> PackageQualified -> Bool
$c/= :: PackageQualified -> PackageQualified -> Bool
== :: PackageQualified -> PackageQualified -> Bool
$c== :: PackageQualified -> PackageQualified -> Bool
Eq, Eq PackageQualified
PackageQualified -> PackageQualified -> Bool
PackageQualified -> PackageQualified -> Ordering
PackageQualified -> PackageQualified -> PackageQualified
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 :: PackageQualified -> PackageQualified -> PackageQualified
$cmin :: PackageQualified -> PackageQualified -> PackageQualified
max :: PackageQualified -> PackageQualified -> PackageQualified
$cmax :: PackageQualified -> PackageQualified -> PackageQualified
>= :: PackageQualified -> PackageQualified -> Bool
$c>= :: PackageQualified -> PackageQualified -> Bool
> :: PackageQualified -> PackageQualified -> Bool
$c> :: PackageQualified -> PackageQualified -> Bool
<= :: PackageQualified -> PackageQualified -> Bool
$c<= :: PackageQualified -> PackageQualified -> Bool
< :: PackageQualified -> PackageQualified -> Bool
$c< :: PackageQualified -> PackageQualified -> Bool
compare :: PackageQualified -> PackageQualified -> Ordering
$ccompare :: PackageQualified -> PackageQualified -> Ordering
Ord, Int -> PackageQualified -> ShowS
[PackageQualified] -> ShowS
PackageQualified -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageQualified] -> ShowS
$cshowList :: [PackageQualified] -> ShowS
show :: PackageQualified -> String
$cshow :: PackageQualified -> String
showsPrec :: Int -> PackageQualified -> ShowS
$cshowsPrec :: Int -> PackageQualified -> ShowS
Show, Eq PackageQualified
Int -> PackageQualified -> Int
PackageQualified -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PackageQualified -> Int
$chash :: PackageQualified -> Int
hashWithSalt :: Int -> PackageQualified -> Int
$chashWithSalt :: Int -> PackageQualified -> Int
Hashable, NonEmpty PackageQualified -> PackageQualified
PackageQualified -> PackageQualified -> PackageQualified
forall b. Integral b => b -> PackageQualified -> PackageQualified
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> PackageQualified -> PackageQualified
$cstimes :: forall b. Integral b => b -> PackageQualified -> PackageQualified
sconcat :: NonEmpty PackageQualified -> PackageQualified
$csconcat :: NonEmpty PackageQualified -> PackageQualified
<> :: PackageQualified -> PackageQualified -> PackageQualified
$c<> :: PackageQualified -> PackageQualified -> PackageQualified
Semigroup, Semigroup PackageQualified
PackageQualified
[PackageQualified] -> PackageQualified
PackageQualified -> PackageQualified -> PackageQualified
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PackageQualified] -> PackageQualified
$cmconcat :: [PackageQualified] -> PackageQualified
mappend :: PackageQualified -> PackageQualified -> PackageQualified
$cmappend :: PackageQualified -> PackageQualified -> PackageQualified
mempty :: PackageQualified
$cmempty :: PackageQualified
Monoid, String -> PackageQualified
forall a. (String -> a) -> IsString a
fromString :: String -> PackageQualified
$cfromString :: String -> PackageQualified
IsString)
instance TypeText PackageQualified where
renderTyCon :: TyCon -> PackageQualified
renderTyCon TyCon
tc = forall a. IsString a => String -> a
fromString (TyCon -> String
tyConPackage TyCon
tc) forall a. Semigroup a => a -> a -> a
<> PackageQualified
"." forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => String -> a
fromString (TyCon -> String
tyConModule TyCon
tc) forall a. Semigroup a => a -> a -> a
<> PackageQualified
"." forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => String -> a
fromString (TyCon -> String
tyConName TyCon
tc)
getPackageQualified :: PackageQualified -> Text
getPackageQualified :: PackageQualified -> Text
getPackageQualified (MkPackageQualified Text
str) = Text
str
showPackageQualified :: TypeRep t -> PackageQualified
showPackageQualified :: forall {k} (t :: k). TypeRep t -> PackageQualified
showPackageQualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep
defaultRenderTypeRep ::
forall tn outer_t.
TypeText tn =>
TypeRep outer_t -> tn
defaultRenderTypeRep :: forall {k} tn (outer_t :: k). TypeText tn => TypeRep outer_t -> tn
defaultRenderTypeRep = forall {k} (t :: k). TypeRep t -> tn
go
where
go :: TypeRep t -> tn
go :: forall {k} (t :: k). TypeRep t -> tn
go (Fun arg :: TypeRep arg
arg@(Fun {}) TypeRep res
res) = tn
"(" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep arg
arg forall a. Semigroup a => a -> a -> a
<> tn
") -> " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep res
res
go (Fun TypeRep arg
arg TypeRep res
res) = forall {k} (t :: k). TypeRep t -> tn
go TypeRep arg
arg forall a. Semigroup a => a -> a -> a
<> tn
" -> " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep res
res
go (App TypeRep a
t1 t2 :: TypeRep b
t2@(Con' TyCon
_ [])) = forall {k} (t :: k). TypeRep t -> tn
go TypeRep a
t1 forall a. Semigroup a => a -> a -> a
<> tn
" " forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep b
t2
go (App TypeRep a
t1 TypeRep b
t2) = forall {k} (t :: k). TypeRep t -> tn
go TypeRep a
t1 forall a. Semigroup a => a -> a -> a
<> tn
" (" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep b
t2 forall a. Semigroup a => a -> a -> a
<> tn
")"
go (Con' TyCon
tc [SomeTypeRep]
kinds) = forall tt. TypeText tt => TyCon -> tt
renderTyCon TyCon
tc forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap SomeTypeRep -> tn
go_kind [SomeTypeRep]
kinds
go_kind :: SomeTypeRep -> tn
go_kind :: SomeTypeRep -> tn
go_kind (SomeTypeRep kind_rep :: TypeRep a
kind_rep@(Con' TyCon
_ [])) = tn
" @" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep a
kind_rep
go_kind (SomeTypeRep TypeRep a
kind_rep) = tn
" @(" forall a. Semigroup a => a -> a -> a
<> forall {k} (t :: k). TypeRep t -> tn
go TypeRep a
kind_rep forall a. Semigroup a => a -> a -> a
<> tn
")"