module Text.Show.Text.Data.Typeable (
showbTypeRepPrec
, showbTyCon
#if MIN_VERSION_base(4,4,0)
, showbFingerprint
#endif
, showbProxy
) where
import Data.Monoid (mempty)
import Data.Proxy (Proxy(..))
import Data.Text.Lazy.Builder (Builder, fromString)
import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon)
#if MIN_VERSION_base(4,4,0)
import Data.Typeable.Internal (TyCon(..), funTc, listTc)
import GHC.Fingerprint.Type (Fingerprint(..))
#else
import Data.Typeable (TyCon, mkTyCon, tyConString, typeOf)
#endif
import Data.Word (Word64)
import Prelude hiding (Show)
import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)
import Text.Show.Text.Data.Integral (showbHex)
import Text.Show.Text.Data.List ()
import Text.Show.Text.Utils ((<>), lengthB, replicateB, s)
showbTypeRepPrec :: Int -> TypeRep -> Builder
showbTypeRepPrec p tyrep =
case tys of
[] -> showbTyCon tycon
[x] | tycon == listTc -> s '[' <> showb x <> s ']'
[a,r] | tycon == funTc -> showbParen (p > 8) $
showbPrec 9 a
<> " -> "
<> showbPrec 8 r
xs | isTupleTyCon tycon -> showbTuple xs
| otherwise -> showbParen (p > 9) $
showbPrec p tycon
<> s ' '
<> showbArgs (s ' ') tys
where
tycon = typeRepTyCon tyrep
tys = typeRepArgs tyrep
#if !(MIN_VERSION_base(4,4,0))
listTc :: TyCon
listTc = typeRepTyCon $ typeOf [()]
funTc :: TyCon
funTc = mkTyCon "->"
#endif
isTupleTyCon :: TyCon -> Bool
isTupleTyCon tycon = case tyconStr of
('(':',':_) -> True
_ -> False
where
tyconStr = tyConString tycon
showbArgs :: Show a => Builder -> [a] -> Builder
showbArgs _ [] = mempty
showbArgs _ [a] = showbPrec 10 a
showbArgs sep (a:as) = showbPrec 10 a <> sep <> showbArgs sep as
showbTuple :: [TypeRep] -> Builder
showbTuple args = s '(' <> showbArgs (s ',') args <> s ')'
showbTyCon :: TyCon -> Builder
showbTyCon = fromString . tyConString
showbProxy :: Proxy s -> Builder
showbProxy _ = "Proxy"
#if MIN_VERSION_base(4,4,0)
showbFingerprint :: Fingerprint -> Builder
showbFingerprint (Fingerprint w1 w2) = hex16 w1 <> hex16 w2
where
hex16 :: Word64 -> Builder
hex16 i = let hex = showbHex i
in replicateB (16 lengthB hex) (s '0') <> hex
#endif
#if MIN_VERSION_base(4,4,0)
tyConString :: TyCon -> String
tyConString = tyConName
#endif
instance Show TypeRep where
showbPrec = showbTypeRepPrec
instance Show TyCon where
showb = showbTyCon
#if MIN_VERSION_base(4,4,0)
instance Show Fingerprint where
showb = showbFingerprint
#endif
instance Show (Proxy s) where
showb = showbProxy