{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE QuantifiedConstraints #-}
#endif
module TextShow.Classes where
import Data.Data (Typeable)
import qualified Data.Text as TS (Text, singleton)
import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)
import qualified Data.Text.Lazy as TL (Text, singleton)
import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (Builder, fromLazyText, fromString,
fromText, singleton, toLazyText)
import GHC.Show (appPrec, appPrec1)
import Prelude ()
import Prelude.Compat
import System.IO (Handle)
import TextShow.Utils (toString, toText)
class TextShow a where
showbPrec :: Int
-> a
-> Builder
showbPrec Int
_ = forall a. TextShow a => a -> Builder
showb
showb :: a
-> Builder
showb = forall a. TextShow a => Int -> a -> Builder
showbPrec Int
0
showbList :: [a]
-> Builder
showbList = forall a. (a -> Builder) -> [a] -> Builder
showbListWith forall a. TextShow a => a -> Builder
showb
showtPrec :: Int
-> a
-> TS.Text
showtPrec Int
p = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => Int -> a -> Text
showtlPrec Int
p
showt :: a
-> TS.Text
showt = forall a. TextShow a => Int -> a -> Text
showtPrec Int
0
showtList :: [a]
-> TS.Text
showtList = Text -> Text
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => [a] -> Text
showtlList
showtlPrec :: Int
-> a
-> TL.Text
showtlPrec Int
p = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => Int -> a -> Builder
showbPrec Int
p
showtl :: a
-> TL.Text
showtl = forall a. TextShow a => Int -> a -> Text
showtlPrec Int
0
showtlList :: [a]
-> TL.Text
showtlList = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => [a] -> Builder
showbList
{-# MINIMAL showbPrec | showb #-}
deriving instance Typeable TextShow
showbParen :: Bool -> Builder -> Builder
showbParen :: Bool -> Builder -> Builder
showbParen Bool
p Builder
builder | Bool
p = Char -> Builder
singleton Char
'(' forall a. Semigroup a => a -> a -> a
<> Builder
builder forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
| Bool
otherwise = Builder
builder
showbCommaSpace :: Builder
showbCommaSpace :: Builder
showbCommaSpace = Builder
", "
showbSpace :: Builder
showbSpace :: Builder
showbSpace = Char -> Builder
singleton Char
' '
showbListWith :: (a -> Builder) -> [a] -> Builder
showbListWith :: forall a. (a -> Builder) -> [a] -> Builder
showbListWith a -> Builder
_ [] = Builder
"[]"
showbListWith a -> Builder
showbx (a
x:[a]
xs) = Char -> Builder
singleton Char
'[' forall a. Semigroup a => a -> a -> a
<> a -> Builder
showbx a
x forall a. Semigroup a => a -> a -> a
<> [a] -> Builder
go [a]
xs
where
go :: [a] -> Builder
go (a
y:[a]
ys) = Char -> Builder
singleton Char
',' forall a. Semigroup a => a -> a -> a
<> a -> Builder
showbx a
y forall a. Semigroup a => a -> a -> a
<> [a] -> Builder
go [a]
ys
go [] = Char -> Builder
singleton Char
']'
showtParen :: Bool -> TS.Text -> TS.Text
showtParen :: Bool -> Text -> Text
showtParen Bool
p Text
t | Bool
p = Char -> Text
TS.singleton Char
'(' forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Char -> Text
TS.singleton Char
')'
| Bool
otherwise = Text
t
showtCommaSpace :: TS.Text
showtCommaSpace :: Text
showtCommaSpace = Text
", "
showtSpace :: TS.Text
showtSpace :: Text
showtSpace = Char -> Text
TS.singleton Char
' '
showtListWith :: (a -> TS.Text) -> [a] -> TS.Text
showtListWith :: forall a. (a -> Text) -> [a] -> Text
showtListWith a -> Text
_ [] = Text
"[]"
showtListWith a -> Text
showtx (a
x:[a]
xs) = Char -> Text
TS.singleton Char
'[' forall a. Semigroup a => a -> a -> a
<> a -> Text
showtx a
x forall a. Semigroup a => a -> a -> a
<> [a] -> Text
go [a]
xs
where
go :: [a] -> Text
go (a
y:[a]
ys) = Char -> Text
TS.singleton Char
',' forall a. Semigroup a => a -> a -> a
<> a -> Text
showtx a
y forall a. Semigroup a => a -> a -> a
<> [a] -> Text
go [a]
ys
go [] = Char -> Text
TS.singleton Char
']'
showtlParen :: Bool -> TL.Text -> TL.Text
showtlParen :: Bool -> Text -> Text
showtlParen Bool
p Text
t | Bool
p = Char -> Text
TL.singleton Char
'(' forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Char -> Text
TL.singleton Char
')'
| Bool
otherwise = Text
t
{-# INLINE showtlParen #-}
showtlCommaSpace :: TL.Text
showtlCommaSpace :: Text
showtlCommaSpace = Text
", "
showtlSpace :: TL.Text
showtlSpace :: Text
showtlSpace = Char -> Text
TL.singleton Char
' '
showtlListWith :: (a -> TL.Text) -> [a] -> TL.Text
showtlListWith :: forall a. (a -> Text) -> [a] -> Text
showtlListWith a -> Text
_ [] = Text
"[]"
showtlListWith a -> Text
showtlx (a
x:[a]
xs) = Char -> Text
TL.singleton Char
'[' forall a. Semigroup a => a -> a -> a
<> a -> Text
showtlx a
x forall a. Semigroup a => a -> a -> a
<> [a] -> Text
go [a]
xs
where
go :: [a] -> Text
go (a
y:[a]
ys) = Char -> Text
TL.singleton Char
',' forall a. Semigroup a => a -> a -> a
<> a -> Text
showtlx a
y forall a. Semigroup a => a -> a -> a
<> [a] -> Text
go [a]
ys
go [] = Char -> Text
TL.singleton Char
']'
printT :: TextShow a => a -> IO ()
printT :: forall a. TextShow a => a -> IO ()
printT = Text -> IO ()
TS.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Text
showt
{-# INLINE printT #-}
printTL :: TextShow a => a -> IO ()
printTL :: forall a. TextShow a => a -> IO ()
printTL = Text -> IO ()
TL.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Text
showtl
{-# INLINE printTL #-}
hPrintT :: TextShow a => Handle -> a -> IO ()
hPrintT :: forall a. TextShow a => Handle -> a -> IO ()
hPrintT Handle
h = Handle -> Text -> IO ()
TS.hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Text
showt
{-# INLINE hPrintT #-}
hPrintTL :: TextShow a => Handle -> a -> IO ()
hPrintTL :: forall a. TextShow a => Handle -> a -> IO ()
hPrintTL Handle
h = Handle -> Text -> IO ()
TL.hPutStrLn Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TextShow a => a -> Text
showtl
{-# INLINE hPrintTL #-}
showsPrecToShowbPrec :: (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec :: forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> a -> ShowS
sp Int
p a
x = String -> Builder
fromString forall a b. (a -> b) -> a -> b
$ Int -> a -> ShowS
sp Int
p a
x String
""
{-# INLINE showsPrecToShowbPrec #-}
showtPrecToShowbPrec :: (Int -> a -> TS.Text) -> Int -> a -> Builder
showtPrecToShowbPrec :: forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtPrecToShowbPrec Int -> a -> Text
sp Int
p = Text -> Builder
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Text
sp Int
p
{-# INLINE showtPrecToShowbPrec #-}
showtlPrecToShowbPrec :: (Int -> a -> TL.Text) -> Int -> a -> Builder
showtlPrecToShowbPrec :: forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtlPrecToShowbPrec Int -> a -> Text
sp Int
p = Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Text
sp Int
p
{-# INLINE showtlPrecToShowbPrec #-}
showsToShowb :: (a -> ShowS) -> a -> Builder
showsToShowb :: forall a. (a -> ShowS) -> a -> Builder
showsToShowb a -> ShowS
sf a
x = String -> Builder
fromString forall a b. (a -> b) -> a -> b
$ a -> ShowS
sf a
x String
""
{-# INLINE showsToShowb #-}
showtToShowb :: (a -> TS.Text) -> a -> Builder
showtToShowb :: forall a. (a -> Text) -> a -> Builder
showtToShowb a -> Text
sf = Text -> Builder
fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
sf
{-# INLINE showtToShowb #-}
showtlToShowb :: (a -> TL.Text) -> a -> Builder
showtlToShowb :: forall a. (a -> Text) -> a -> Builder
showtlToShowb a -> Text
sf = Text -> Builder
fromLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
sf
{-# INLINE showtlToShowb #-}
showbPrecToShowsPrec :: (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec :: forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> a -> Builder
sp Int
p = String -> ShowS
showString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Builder
sp Int
p
{-# INLINE showbPrecToShowsPrec #-}
showbPrecToShowtPrec :: (Int -> a -> Builder) -> Int -> a -> TS.Text
showbPrecToShowtPrec :: forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtPrec Int -> a -> Builder
sp Int
p = Builder -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Builder
sp Int
p
{-# INLINE showbPrecToShowtPrec #-}
showbPrecToShowtlPrec :: (Int -> a -> Builder) -> Int -> a -> TL.Text
showbPrecToShowtlPrec :: forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtlPrec Int -> a -> Builder
sp Int
p = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Builder
sp Int
p
{-# INLINE showbPrecToShowtlPrec #-}
showbToShows :: (a -> Builder) -> a -> ShowS
showbToShows :: forall a. (a -> Builder) -> a -> ShowS
showbToShows a -> Builder
sf = String -> ShowS
showString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
sf
{-# INLINE showbToShows #-}
showbToShowt :: (a -> Builder) -> a -> TS.Text
showbToShowt :: forall a. (a -> Builder) -> a -> Text
showbToShowt a -> Builder
sf = Builder -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
sf
{-# INLINE showbToShowt #-}
showbToShowtl :: (a -> Builder) -> a -> TL.Text
showbToShowtl :: forall a. (a -> Builder) -> a -> Text
showbToShowtl a -> Builder
sf = Builder -> Text
toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
sf
{-# INLINE showbToShowtl #-}
class
#if __GLASGOW_HASKELL__ >= 806
(forall a. TextShow a => TextShow (f a)) =>
#endif
TextShow1 f where
liftShowbPrec :: (Int -> a -> Builder) -> ([a] -> Builder)
-> Int -> f a -> Builder
liftShowbList :: (Int -> a -> Builder) -> ([a] -> Builder)
-> [f a] -> Builder
liftShowbList Int -> a -> Builder
sp [a] -> Builder
sl = forall a. (a -> Builder) -> [a] -> Builder
showbListWith (forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec Int -> a -> Builder
sp [a] -> Builder
sl Int
0)
{-# MINIMAL liftShowbPrec #-}
deriving instance Typeable TextShow1
showbPrec1 :: (TextShow1 f, TextShow a) => Int -> f a -> Builder
showbPrec1 :: forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1 = forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList
{-# INLINE showbPrec1 #-}
showbUnaryWith :: (Int -> a -> Builder) -> Builder -> Int -> a -> Builder
showbUnaryWith :: forall a. (Int -> a -> Builder) -> Builder -> Int -> a -> Builder
showbUnaryWith Int -> a -> Builder
sp Builder
nameB Int
p a
x = Bool -> Builder -> Builder
showbParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$
Builder
nameB forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace forall a. Semigroup a => a -> a -> a
<> Int -> a -> Builder
sp Int
appPrec1 a
x
{-# INLINE showbUnaryWith #-}
liftShowtPrec :: TextShow1 f => (Int -> a -> TS.Text) -> ([a] -> TS.Text)
-> Int -> f a -> TS.Text
liftShowtPrec :: forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Text) -> ([a] -> Text) -> Int -> f a -> Text
liftShowtPrec Int -> a -> Text
sp [a] -> Text
sl = forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtPrec forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec (forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtPrecToShowbPrec Int -> a -> Text
sp) (forall a. (a -> Text) -> a -> Builder
showtToShowb [a] -> Text
sl)
liftShowtlPrec :: TextShow1 f => (Int -> a -> TL.Text) -> ([a] -> TL.Text)
-> Int -> f a -> TL.Text
liftShowtlPrec :: forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Text) -> ([a] -> Text) -> Int -> f a -> Text
liftShowtlPrec Int -> a -> Text
sp [a] -> Text
sl = forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtlPrec forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec (forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtlPrecToShowbPrec Int -> a -> Text
sp) (forall a. (a -> Text) -> a -> Builder
showtlToShowb [a] -> Text
sl)
class
#if __GLASGOW_HASKELL__ >= 806
( forall a. TextShow a => TextShow1 (f a)
# if __GLASGOW_HASKELL__ < 900
, forall a b. (TextShow a, TextShow b) => TextShow (f a b)
# endif
) =>
#endif
TextShow2 f where
liftShowbPrec2 :: (Int -> a -> Builder) -> ([a] -> Builder)
-> (Int -> b -> Builder) -> ([b] -> Builder)
-> Int -> f a b -> Builder
liftShowbList2 :: (Int -> a -> Builder) -> ([a] -> Builder)
-> (Int -> b -> Builder) -> ([b] -> Builder)
-> [f a b] -> Builder
liftShowbList2 Int -> a -> Builder
sp1 [a] -> Builder
sl1 Int -> b -> Builder
sp2 [b] -> Builder
sl2 =
forall a. (a -> Builder) -> [a] -> Builder
showbListWith (forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 Int -> a -> Builder
sp1 [a] -> Builder
sl1 Int -> b -> Builder
sp2 [b] -> Builder
sl2 Int
0)
{-# MINIMAL liftShowbPrec2 #-}
deriving instance Typeable TextShow2
showbPrec2 :: (TextShow2 f, TextShow a, TextShow b) => Int -> f a b -> Builder
showbPrec2 :: forall (f :: * -> * -> *) a b.
(TextShow2 f, TextShow a, TextShow b) =>
Int -> f a b -> Builder
showbPrec2 = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList
{-# INLINE showbPrec2 #-}
showbBinaryWith :: (Int -> a -> Builder) -> (Int -> b -> Builder) ->
Builder -> Int -> a -> b -> Builder
showbBinaryWith :: forall a b.
(Int -> a -> Builder)
-> (Int -> b -> Builder) -> Builder -> Int -> a -> b -> Builder
showbBinaryWith Int -> a -> Builder
sp1 Int -> b -> Builder
sp2 Builder
nameB Int
p a
x b
y = Bool -> Builder -> Builder
showbParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
appPrec) forall a b. (a -> b) -> a -> b
$ Builder
nameB
forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace forall a. Semigroup a => a -> a -> a
<> Int -> a -> Builder
sp1 Int
appPrec1 a
x
forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace forall a. Semigroup a => a -> a -> a
<> Int -> b -> Builder
sp2 Int
appPrec1 b
y
{-# INLINE showbBinaryWith #-}
liftShowtPrec2 :: TextShow2 f
=> (Int -> a -> TS.Text) -> ([a] -> TS.Text)
-> (Int -> b -> TS.Text) -> ([b] -> TS.Text)
-> Int -> f a b -> TS.Text
liftShowtPrec2 :: forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Text)
-> ([a] -> Text)
-> (Int -> b -> Text)
-> ([b] -> Text)
-> Int
-> f a b
-> Text
liftShowtPrec2 Int -> a -> Text
sp1 [a] -> Text
sl1 Int -> b -> Text
sp2 [b] -> Text
sl2 = forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtPrec forall a b. (a -> b) -> a -> b
$
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 (forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtPrecToShowbPrec Int -> a -> Text
sp1) (forall a. (a -> Text) -> a -> Builder
showtToShowb [a] -> Text
sl1)
(forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtPrecToShowbPrec Int -> b -> Text
sp2) (forall a. (a -> Text) -> a -> Builder
showtToShowb [b] -> Text
sl2)
liftShowtlPrec2 :: TextShow2 f
=> (Int -> a -> TL.Text) -> ([a] -> TL.Text)
-> (Int -> b -> TL.Text) -> ([b] -> TL.Text)
-> Int -> f a b -> TL.Text
liftShowtlPrec2 :: forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Text)
-> ([a] -> Text)
-> (Int -> b -> Text)
-> ([b] -> Text)
-> Int
-> f a b
-> Text
liftShowtlPrec2 Int -> a -> Text
sp1 [a] -> Text
sl1 Int -> b -> Text
sp2 [b] -> Text
sl2 = forall a. (Int -> a -> Builder) -> Int -> a -> Text
showbPrecToShowtlPrec forall a b. (a -> b) -> a -> b
$
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 (forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtlPrecToShowbPrec Int -> a -> Text
sp1) (forall a. (a -> Text) -> a -> Builder
showtlToShowb [a] -> Text
sl1)
(forall a. (Int -> a -> Text) -> Int -> a -> Builder
showtlPrecToShowbPrec Int -> b -> Text
sp2) (forall a. (a -> Text) -> a -> Builder
showtlToShowb [b] -> Text
sl2)