{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
#if MIN_VERSION_text(0,9,0)
{-# LANGUAGE TemplateHaskell   #-}
#endif
{-# OPTIONS_GHC -fno-warn-deprecations #-} -- TODO: Remove this later
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Text
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Defines 'TextShow' instances for 'Text' types, as well as other miscellaneous
data types from the @text@ package.

Note that this module deliberately does not define a 'TextShow' instance for
the @I16@ data type from @Data.Text.Foreign@, as that module is not available
on certain widely used variants of GHC (e.g., @reflex-platform@). See #40
for more details. If this is a problem for you, please file an issue.

/Since: 2/
-}
module TextShow.Data.Text () where

import qualified Data.Text as TS
import           Data.Text.Encoding.Error (UnicodeException(..))
import qualified Data.Text.Lazy as TL
import           Data.Text.Lazy.Builder (Builder, fromString, toLazyText)

import           Prelude ()
import           Prelude.Compat

import           TextShow.Classes (TextShow(..))
import           TextShow.Data.Char (showbString)
import           TextShow.Data.Integral (showbHex)
import           TextShow.TH.Internal (deriveTextShow)

#if MIN_VERSION_text(1,0,0)
import           Data.Text.Encoding (Decoding(..))
import           Data.Text.Lazy.Builder (singleton)
import           GHC.Show (appPrec)
import           TextShow.Classes (showbParen)
import           TextShow.Data.ByteString ()
#endif

#if MIN_VERSION_text(1,1,0)
import           Data.Text.Internal.Fusion.Size (Size)
#endif

-- | /Since: 2/
instance TextShow TS.Text where
    showb :: Text -> Builder
showb = String -> Builder
showbString (String -> Builder) -> (Text -> String) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TS.unpack
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow TL.Text where
    showb :: Text -> Builder
showb = String -> Builder
showbString (String -> Builder) -> (Text -> String) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow Builder where
    showb :: Builder -> Builder
showb = Text -> Builder
forall a. TextShow a => a -> Builder
showb (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow UnicodeException where
    showb :: UnicodeException -> Builder
showb (DecodeError String
desc (Just Word8
w))
        = Builder
"Cannot decode byte '\\x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
forall a. (Integral a, TextShow a) => a -> Builder
showbHex Word8
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"': " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
desc
    showb (DecodeError String
desc Maybe Word8
Nothing)
        = Builder
"Cannot decode input: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
desc
    showb (EncodeError String
desc (Just Char
c))
        = Builder
"Cannot encode character '\\x" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. (Integral a, TextShow a) => a -> Builder
showbHex (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"': " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
desc
    showb (EncodeError String
desc Maybe Char
Nothing)
        = Builder
"Cannot encode input: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
fromString String
desc

#if MIN_VERSION_text(1,0,0)
-- | Only available with @text-1.0.0.0@ or later.
--
-- /Since: 2/
instance TextShow Decoding where
    showbPrec :: Int -> Decoding -> Builder
showbPrec Int
p (Some Text
t ByteString
bs ByteString -> Decoding
_) = Bool -> Builder -> Builder
showbParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
        Builder
"Some " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. TextShow a => a -> Builder
showb Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Char -> Builder
singleton Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
forall a. TextShow a => a -> Builder
showb ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
" _"
    {-# INLINE showbPrec #-}
#endif

#if MIN_VERSION_text(1,1,0)
-- | Only available with @text-1.1.0.0@ or later.
--
-- /Since: 2/
$(deriveTextShow ''Size)
#endif