module Text.Show.HT where

{-| Show a value using an infix operator. -}
{-# INLINE showsInfixPrec #-}
showsInfixPrec ::
   (Show a, Show b) =>
   String -> Int -> Int -> a -> b -> ShowS
showsInfixPrec :: String -> Int -> Int -> a -> b -> ShowS
showsInfixPrec String
opStr Int
opPrec Int
prec a
x b
y =
   Bool -> ShowS -> ShowS
showParen
     (Int
prec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
opPrec)
     (Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
opPrec a
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
showString String
opStr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
opPrec b
y)

concatS :: [ShowS] -> ShowS
concatS :: [ShowS] -> ShowS
concatS = (String -> [ShowS] -> String) -> [ShowS] -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ShowS -> ShowS) -> String -> [ShowS] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS
forall a b. (a -> b) -> a -> b
($))

{-
precedences

appPrec :: Int
appPrec = 10
-}