{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.System.IO () where
import Data.Text.Lazy.Builder (Builder, fromString, singleton)
import GHC.IO.Encoding.Failure (CodingFailureMode)
import GHC.IO.Encoding.Types (CodingProgress, TextEncoding(textEncodingName))
import GHC.IO.Handle (HandlePosn(..))
import GHC.IO.Handle.Types (Handle(..))
import Prelude ()
import Prelude.Compat
import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode)
import TextShow.Classes (TextShow(..))
import TextShow.Data.Integral ()
import TextShow.Data.Maybe ()
import TextShow.TH.Internal (deriveTextShow)
instance TextShow Handle where
showb :: Handle -> Builder
showb (FileHandle FilePath
file MVar Handle__
_) = FilePath -> Builder
showbHandleFilePath FilePath
file
showb (DuplexHandle FilePath
file MVar Handle__
_ MVar Handle__
_) = FilePath -> Builder
showbHandleFilePath FilePath
file
{-# INLINE showb #-}
showbHandleFilePath :: FilePath -> Builder
showbHandleFilePath :: FilePath -> Builder
showbHandleFilePath FilePath
file = Builder
"{handle: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FilePath -> Builder
fromString FilePath
file Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'}'
{-# INLINE showbHandleFilePath #-}
$(deriveTextShow ''IOMode)
$(deriveTextShow ''BufferMode)
instance TextShow HandlePosn where
showb :: HandlePosn -> Builder
showb (HandlePosn Handle
h HandlePosition
pos) = Handle -> Builder
forall a. TextShow a => a -> Builder
showb Handle
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" at position " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> HandlePosition -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec Int
0 HandlePosition
pos
{-# INLINE showb #-}
$(deriveTextShow ''SeekMode)
instance TextShow TextEncoding where
showb :: TextEncoding -> Builder
showb = FilePath -> Builder
fromString (FilePath -> Builder)
-> (TextEncoding -> FilePath) -> TextEncoding -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextEncoding -> FilePath
textEncodingName
{-# INLINE showb #-}
$(deriveTextShow ''CodingProgress)
$(deriveTextShow ''CodingFailureMode)
$(deriveTextShow ''Newline)
$(deriveTextShow ''NewlineMode)