{-# LANGUAGE OverloadedStrings #-}

{-|
Description : Utilities for controlling how to serialize type representations into strings
Copyright   : Richard Eisenberg
License     : MIT
Maintainer  : rae@richarde.dev
Stability   : experimental

This module provides three different ways of serializing a 'TypeRep' into a 'Text':
qualifying no names, qualifying all names, or package-qualifying all names. In order
to support meaningful notions of equality on these string representations (for e.g.
using them as keys in a map), @newtype@s are provided for each format.

-}

module Type.Reflection.Name (
  -- * Unqualified names
  Unqualified(..), getUnqualified, showUnqualified,

  -- * Qualified names
  Qualified(..), getQualified, showQualified,

  -- * Package-qualified names
  PackageQualified(..), getPackageQualified, showPackageQualified,

  -- * Class-based access
  TypeText(..), defaultRenderTypeRep,

  ) where

import Data.String ( IsString(..) )
import Data.Hashable ( Hashable )
import Data.Text ( Text )

import Type.Reflection

------------------------------------------------------
-- TypeText, a class that describes how TyCons are rendered

-- | The 'TypeText' class describes how a 'TyCon' is rendered
-- into a textual representation, and it is used to render a 'TypeRep'
-- by 'renderTypeRep'. The 'IsString' superclass is needed to insert
-- connectives like spaces, dots, and parentheses, and the 'Monoid'
-- superclass is needed to stitch these pieces together.
--
-- Only 'renderTyCon' is needed for instances; if 'renderTypeRep' is
-- omitted, then the default rendering, via 'defaultRenderTypeRep' is
-- used. See that function for more details.
--
-- The only consistency law for 'TypeText' is this, holding for all
-- @tr@ of type 'TypeRep' :
--
-- > case tr of Con' tc [] -> renderTypeRep tr == renderTyCon tc
-- >            _ -> True
--
-- In other words, rendering a 'TypeRep' consisting only of a 'TyCon'
-- is the same as rendering the 'TyCon' itself. If the 'TypeRep' is not
-- a plain 'TyCon' (with no kind arguments), then there are no applicable
-- laws. Note that the law uses '==', even though 'Eq' is not a superclass
-- of 'TypeText'.
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 #-}

------------------------------------------------------
-- Unqualified

-- | A rendering of a type where no components have module or package qualifications.
-- Data constructors used in types are preceded with a @'@, and infix operator types
-- are printed without parentheses. Uses 'defaultRenderTypeRep' to render types; see
-- that function for further details.
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

-- | Extract the contents of an 'Unqualified' rendering
getUnqualified :: Unqualified -> Text
getUnqualified :: Unqualified -> Text
getUnqualified (MkUnqualified Text
str) = Text
str

-- | Convert a 'TypeRep' into an 'Unqualified' representation
showUnqualified :: TypeRep t -> Unqualified
showUnqualified :: forall {k} (t :: k). TypeRep t -> Unqualified
showUnqualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep

----------------------------------------------------------
-- Qualified

-- | A rendering of a type where all components have module qualifications.
-- Data constructors used in types are preceded first with their module qualification,
-- and then with a @'@, and infix operator types
-- are printed without parentheses. So we have @Data.Proxy.'Proxy@ for the v'Proxy' constructor.
-- Uses 'defaultRenderTypeRep' to render types; see
-- that function for further details.j
--
-- Note that module qualifications arise from the module that defines a type, even if this
-- is a hidden or internal module. This fact means that internal-structure changes in
-- your libraries may affect how your types are rendered, including changes in e.g. @base@.
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)

-- | Extract the contents of a 'Qualified' rendering
getQualified :: Qualified -> Text
getQualified :: Qualified -> Text
getQualified (MkQualified Text
str) = Text
str

-- | Convert a 'TypeRep' into a 'Qualified' representation
showQualified :: TypeRep t -> Qualified
showQualified :: forall {k} (t :: k). TypeRep t -> Qualified
showQualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep

------------------------------------------------------------
-- PackageQualified

-- | A rendering of a type where all components have package and module qualifications
-- Data constructors used in types are preceded first with their package qualification,
-- and then their module qualification,
-- and then with a @'@, and infix operator types
-- are printed without parentheses. So we have @base.Data.Proxy.'Proxy@ for the v'Proxy' constructor.
-- Uses 'defaultRenderTypeRep' to render types; see
-- that function for further details.
--
-- Note that module qualifications arise from the module that defines a type, even if this
-- is a hidden or internal module. This fact means that internal-structure changes in
-- your libraries may affect how your types are rendered, including changes in e.g. @base@.
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)

-- | Extract the contents of a 'PackageQualified' name
getPackageQualified :: PackageQualified -> Text
getPackageQualified :: PackageQualified -> Text
getPackageQualified (MkPackageQualified Text
str) = Text
str

-- | Convert a 'TypeRep' into a 'PackageQualified' representation
showPackageQualified :: TypeRep t -> PackageQualified
showPackageQualified :: forall {k} (t :: k). TypeRep t -> PackageQualified
showPackageQualified = forall tt {k} (t :: k). TypeText tt => TypeRep t -> tt
renderTypeRep

----------------------------------------------
-- Worker

-- | Render a 'TypeRep' into an instance of 'TypeText'. This follows the following
-- rules for how to render a type:
--
-- * Function types are rendered infix. If a function takes another function as an
-- argument, the argument function is rendered in parentheses (as required by the
-- right-associative @->@ operator).
--
-- * All other type constructors are rendered prefix, including the list constructor @[]@
-- and the tuple constructors e.g. @(,,)@, along with any other type operators.
--
-- * All kind arguments to type constructors are rendered, with \@ prefixes. Any
-- non-atomic (that is, not simply a type constructor with no kind arguments) kinds
-- are enclosed in parentheses.
--
-- * Non-atomic arguments are enclosed in parentheses.
--
-- * Type synonyms are always expanded. This means that we get @[] Char@, not @String@,
-- and we get @TYPE ('BoxedRep 'Lifted)@, not @Type@.
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
")"