#if __GLASGOW_HASKELL__ >= 702
#endif
#if __GLASGOW_HASKELL__ >= 706
#endif
#if __GLASGOW_HASKELL__ >= 708
#endif
module Text.Show.Text.Generic (
#if __GLASGOW_HASKELL__ < 702
) where
#else
genericShow
, genericShowLazy
, genericShowPrec
, genericShowPrecLazy
, genericShowList
, genericShowListLazy
, genericShowb
, genericShowbPrec
, genericShowbList
, genericPrint
, genericPrintLazy
, genericHPrint
, genericHPrintLazy
, GShow(..)
, ConType(..)
) where
import Data.Monoid.Compat ((<>))
import qualified Data.Text as TS (Text)
import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (Builder, fromString, toLazyText)
import qualified Data.Text.Lazy as TL (Text)
import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)
import Data.Typeable (Typeable)
import GHC.Generics
import GHC.Show (appPrec, appPrec1)
import Prelude ()
import Prelude.Compat hiding (Show)
import System.IO (Handle)
import qualified Text.Show as S (Show)
import qualified Text.Show.Text.Classes as T
import Text.Show.Text.Classes (Show(showbPrec), showbListWith,
showbParen, showbSpace)
import Text.Show.Text.Instances ()
import Text.Show.Text.Utils (isInfixTypeCon, isTupleString, s, toString)
# include "inline.h"
genericShow :: (Generic a, GShow (Rep a)) => a -> TS.Text
genericShow = toStrict . genericShowLazy
genericShowLazy :: (Generic a, GShow (Rep a)) => a -> TL.Text
genericShowLazy = toLazyText . genericShowb
genericShowPrec :: (Generic a, GShow (Rep a)) => Int -> a -> TS.Text
genericShowPrec p = toStrict . genericShowPrecLazy p
genericShowPrecLazy :: (Generic a, GShow (Rep a)) => Int -> a -> TL.Text
genericShowPrecLazy p = toLazyText . genericShowbPrec p
genericShowList :: (Generic a, GShow (Rep a)) => [a] -> TS.Text
genericShowList = toStrict . genericShowListLazy
genericShowListLazy :: (Generic a, GShow (Rep a)) => [a] -> TL.Text
genericShowListLazy = toLazyText . genericShowbList
genericShowb :: (Generic a, GShow (Rep a)) => a -> Builder
genericShowb = genericShowbPrec 0
genericShowbPrec :: (Generic a, GShow (Rep a)) => Int -> a -> Builder
genericShowbPrec p = gShowbPrec Pref p . from
genericShowbList :: (Generic a, GShow (Rep a)) => [a] -> Builder
genericShowbList = showbListWith genericShowb
genericPrint :: (Generic a, GShow (Rep a)) => a -> IO ()
genericPrint = TS.putStrLn . genericShow
genericPrintLazy :: (Generic a, GShow (Rep a)) => a -> IO ()
genericPrintLazy = TL.putStrLn . genericShowLazy
genericHPrint :: (Generic a, GShow (Rep a)) => Handle -> a -> IO ()
genericHPrint h = TS.hPutStrLn h . genericShow
genericHPrintLazy :: (Generic a, GShow (Rep a)) => Handle -> a -> IO ()
genericHPrintLazy h = TL.hPutStrLn h . genericShowLazy
data ConType = Rec | Tup | Pref | Inf Builder
deriving ( Generic
, S.Show
, Typeable
# if MIN_VERSION_text(0,11,1)
, Eq
, Ord
# endif
)
instance T.Show ConType where
showbPrec = genericShowbPrec
INLINE_INST_FUN(showbPrec)
class GShow f where
gShowbPrec :: ConType -> Int -> f a -> Builder
isNullary :: f a -> Bool
isNullary = error "generic show (isNullary): unnecessary case"
# if __GLASGOW_HASKELL__ >= 708
deriving instance Typeable GShow
# endif
instance GShow U1 where
gShowbPrec _ _ U1 = mempty
isNullary _ = True
instance T.Show c => GShow (K1 i c) where
gShowbPrec _ n (K1 a) = showbPrec n a
isNullary _ = False
instance (Constructor c, GShow a) => GShow (M1 C c a) where
gShowbPrec _ n c@(M1 x) = case fixity of
Prefix -> showbParen ( n > appPrec
&& not ( isNullary x
|| conIsTuple c
# if __GLASGOW_HASKELL__ >= 711
|| conIsRecord c
# endif
)
) $
(if conIsTuple c
then mempty
else let cn = conName c
in showbParen (isInfixTypeCon cn) $ fromString cn
)
<> (if isNullary x || conIsTuple c
then mempty
else s ' '
)
<> showbBraces t (gShowbPrec t appPrec1 x)
Infix _ m -> showbParen (n > m) . showbBraces t $ gShowbPrec t (m+1) x
where
fixity :: Fixity
fixity = conFixity c
t :: ConType
t = if conIsRecord c
then Rec
else case conIsTuple c of
True -> Tup
False -> case fixity of
Prefix -> Pref
Infix _ _ -> Inf . fromString $ conName c
showbBraces :: ConType -> Builder -> Builder
showbBraces Rec b = s '{' <> b <> s '}'
showbBraces Tup b = s '(' <> b <> s ')'
showbBraces Pref b = b
showbBraces (Inf _) b = b
conIsTuple :: M1 C c a b -> Bool
conIsTuple = isTupleString . conName
instance (Selector s, GShow a) => GShow (M1 S s a) where
gShowbPrec t n sel@(M1 x)
| selName sel == "" = gShowbPrec t n x
| otherwise = fromString (selName sel) <> " = " <> gShowbPrec t 0 x
isNullary (M1 x) = isNullary x
instance GShow a => GShow (M1 D d a) where
gShowbPrec t n (M1 x) = gShowbPrec t n x
instance (GShow a, GShow b) => GShow (a :+: b) where
gShowbPrec t n (L1 x) = gShowbPrec t n x
gShowbPrec t n (R1 x) = gShowbPrec t n x
instance (GShow a, GShow b) => GShow (a :*: b) where
gShowbPrec t@Rec _ (a :*: b) =
gShowbPrec t 0 a
<> ", "
<> gShowbPrec t 0 b
gShowbPrec t@(Inf o) n (a :*: b) =
gShowbPrec t n a
<> showbSpace
<> infixOp
<> showbSpace
<> gShowbPrec t n b
where
infixOp :: Builder
infixOp = if isInfixTypeCon (toString o)
then o
else s '`' <> o <> s '`'
gShowbPrec t@Tup _ (a :*: b) =
gShowbPrec t 0 a
<> s ','
<> gShowbPrec t 0 b
gShowbPrec t@Pref n (a :*: b) =
gShowbPrec t n a
<> showbSpace
<> gShowbPrec t n b
isNullary _ = False
#endif