#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))
#endif
module TextShow.Data.OldTypeable (
#if !(MIN_VERSION_base(4,7,0)) || MIN_VERSION_base(4,8,0)
) where
#else
showbTyCon
, showbTypeRepPrec
) where
import Data.Monoid.Compat ((<>))
import Data.OldTypeable.Internal (TyCon(TyCon, tyConName), TypeRep(..),
funTc, listTc)
import Data.Text.Lazy.Builder (Builder, fromString, singleton)
import TextShow.Classes (TextShow(showb, showbPrec), showbParen, showbSpace)
import TextShow.Data.Typeable.Utils (showbArgs, showbTuple)
import TextShow.Utils (isTupleString)
showbTyCon :: TyCon -> Builder
showbTyCon = fromString . tyConName
showbTypeRepPrec :: Int -> TypeRep -> Builder
showbTypeRepPrec p (TypeRep _ tycon tys) =
case tys of
[] -> showbTyCon tycon
[x] | tycon == listTc -> singleton '[' <> showb x <> singleton ']'
[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
<> showbSpace
<> showbArgs showbSpace tys
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (TyCon _ _ _ str) = isTupleString str
instance TextShow TyCon where
showb = showbTyCon
instance TextShow TypeRep where
showbPrec = showbTypeRepPrec
#endif