module Text.Show.Text.System.IO (
showbHandle
, showbIOMode
, showbBufferModePrec
, showbHandlePosn
, showbSeekMode
#if MIN_VERSION_base(4,3,0)
, showbTextEncoding
#endif
#if MIN_VERSION_base(4,4,0)
, showbCodingProgress
, showbCodingFailureMode
#endif
, showbNewline
, showbNewlineModePrec
) where
import Data.Text.Lazy.Builder (Builder, fromString)
#include "inline.h"
#if MIN_VERSION_base(4,3,0)
import GHC.IO.Encoding.Types (TextEncoding(textEncodingName))
#endif
#if MIN_VERSION_base(4,4,0)
import GHC.IO.Encoding.Failure (CodingFailureMode)
import GHC.IO.Encoding.Types (CodingProgress)
#endif
import GHC.IO.Handle (HandlePosn(..))
import GHC.IO.Handle.Types (Handle(..))
import Prelude hiding (Show)
import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode)
import Text.Show.Text.Classes (Show(showb, showbPrec))
import Text.Show.Text.Data.Integral (showbIntegerPrec)
import Text.Show.Text.Data.Maybe ()
import Text.Show.Text.TH.Internal (deriveShow, deriveShowPragmas,
defaultInlineShowb, defaultInlineShowbPrec)
import Text.Show.Text.Utils ((<>), s)
showbHandle :: Handle -> Builder
showbHandle (FileHandle file _) = showbHandleFilePath file
showbHandle (DuplexHandle file _ _) = showbHandleFilePath file
showbHandleFilePath :: FilePath -> Builder
showbHandleFilePath file = "{handle: " <> fromString file <> s '}'
showbIOMode :: IOMode -> Builder
showbIOMode = showb
showbBufferModePrec :: Int -> BufferMode -> Builder
showbBufferModePrec = showbPrec
showbHandlePosn :: HandlePosn -> Builder
showbHandlePosn (HandlePosn h pos)
= showbHandle h <> " at position " <> showbIntegerPrec 0 pos
showbSeekMode :: SeekMode -> Builder
showbSeekMode = showb
#if MIN_VERSION_base(4,3,0)
showbTextEncoding :: TextEncoding -> Builder
showbTextEncoding = fromString . textEncodingName
#endif
#if MIN_VERSION_base(4,4,0)
showbCodingProgress :: CodingProgress -> Builder
showbCodingProgress = showb
showbCodingFailureMode :: CodingFailureMode -> Builder
showbCodingFailureMode = showb
#endif
showbNewline :: Newline -> Builder
showbNewline = showb
showbNewlineModePrec :: Int -> NewlineMode -> Builder
showbNewlineModePrec = showbPrec
instance Show Handle where
showb = showbHandle
INLINE_INST_FUN(showb)
$(deriveShowPragmas defaultInlineShowb ''IOMode)
$(deriveShow ''BufferMode)
instance Show HandlePosn where
showb = showbHandlePosn
INLINE_INST_FUN(showb)
$(deriveShowPragmas defaultInlineShowb ''SeekMode)
#if MIN_VERSION_base(4,3,0)
instance Show TextEncoding where
showb = showbTextEncoding
INLINE_INST_FUN(showb)
#endif
#if MIN_VERSION_base(4,4,0)
$(deriveShowPragmas defaultInlineShowb ''CodingProgress)
$(deriveShowPragmas defaultInlineShowb ''CodingFailureMode)
#endif
$(deriveShowPragmas defaultInlineShowb ''Newline)
$(deriveShowPragmas defaultInlineShowbPrec ''NewlineMode)