{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module RIO.Prelude.Display
  ( Utf8Builder (..)
  , Display (..)
  , displayShow
  , utf8BuilderToText
  , utf8BuilderToLazyText
  , displayBytesUtf8
  , writeFileUtf8Builder
  ) where

import Data.String (IsString (..))
import           Data.ByteString          (ByteString)
import qualified Data.ByteString.Lazy     as BL
import qualified Data.ByteString.Builder  as BB
import           Data.ByteString.Builder  (Builder)
import           Data.Semigroup           (Semigroup(..))
import           Data.Text                (Text)
import qualified Data.Text.Lazy           as TL
import qualified Data.Text.Lazy.Encoding  as TL
import UnliftIO
import           Data.Text.Encoding       (decodeUtf8With, encodeUtf8Builder)
import           Data.Text.Encoding.Error (lenientDecode)
import           Data.Int
import           Data.Word
import           System.Process.Typed     (ProcessConfig, setEnvInherit)

-- | A builder of binary data, with the invariant that the underlying
-- data is supposed to be UTF-8 encoded.
--
-- @since 0.1.0.0
newtype Utf8Builder = Utf8Builder { Utf8Builder -> Builder
getUtf8Builder :: Builder }
  deriving (b -> Utf8Builder -> Utf8Builder
NonEmpty Utf8Builder -> Utf8Builder
Utf8Builder -> Utf8Builder -> Utf8Builder
(Utf8Builder -> Utf8Builder -> Utf8Builder)
-> (NonEmpty Utf8Builder -> Utf8Builder)
-> (forall b. Integral b => b -> Utf8Builder -> Utf8Builder)
-> Semigroup Utf8Builder
forall b. Integral b => b -> Utf8Builder -> Utf8Builder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Utf8Builder -> Utf8Builder
$cstimes :: forall b. Integral b => b -> Utf8Builder -> Utf8Builder
sconcat :: NonEmpty Utf8Builder -> Utf8Builder
$csconcat :: NonEmpty Utf8Builder -> Utf8Builder
<> :: Utf8Builder -> Utf8Builder -> Utf8Builder
$c<> :: Utf8Builder -> Utf8Builder -> Utf8Builder
Semigroup)

-- Custom instance is created instead of deriving, otherwise list fusion breaks
-- for `mconcat`.
instance Monoid Utf8Builder where
  mempty :: Utf8Builder
mempty = Builder -> Utf8Builder
Utf8Builder Builder
forall a. Monoid a => a
mempty
  {-# INLINE mempty #-}
  mappend :: Utf8Builder -> Utf8Builder -> Utf8Builder
mappend = Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Semigroup a => a -> a -> a
(Data.Semigroup.<>)
  {-# INLINE mappend #-}
  mconcat :: [Utf8Builder] -> Utf8Builder
mconcat = (Utf8Builder -> Utf8Builder -> Utf8Builder)
-> Utf8Builder -> [Utf8Builder] -> Utf8Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Utf8Builder -> Utf8Builder -> Utf8Builder
forall a. Monoid a => a -> a -> a
mappend Utf8Builder
forall a. Monoid a => a
mempty
  {-# INLINE mconcat #-}

-- | @since 0.1.0.0
instance IsString Utf8Builder where
  fromString :: String -> Utf8Builder
fromString = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (String -> Builder) -> String -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
BB.stringUtf8

-- | A typeclass for values which can be converted to a
-- 'Utf8Builder'. The intention of this typeclass is to provide a
-- human-friendly display of the data.
--
-- @since 0.1.0.0
class Display a where
  {-# MINIMAL display | textDisplay #-}

  display :: a -> Utf8Builder
  display = Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (Text -> Utf8Builder) -> (a -> Text) -> a -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Display a => a -> Text
textDisplay

  -- | Display data as `Text`, which will also be used for `display` if it is
  -- not overriden.
  --
  -- @since 0.1.7.0
  textDisplay :: a -> Text
  textDisplay = Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

-- | @since 0.1.0.0
instance Display Utf8Builder where
  display :: Utf8Builder -> Utf8Builder
display = Utf8Builder -> Utf8Builder
forall a. a -> a
id
-- | @since 0.1.0.0
instance Display Text where
  display :: Text -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Text -> Builder) -> Text -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
encodeUtf8Builder
-- | @since 0.1.0.0
instance Display TL.Text where
  display :: Text -> Utf8Builder
display = (Text -> Utf8Builder) -> [Text] -> Utf8Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display ([Text] -> Utf8Builder) -> (Text -> [Text]) -> Text -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
TL.toChunks
-- | @since 0.1.0.0
instance Display Char where
  display :: Char -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Char -> Builder) -> Char -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
BB.charUtf8

-- | @since 0.1.0.0
instance Display Integer where
  display :: Integer -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Integer -> Builder) -> Integer -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Builder
BB.integerDec
-- | @since 0.1.0.0
instance Display Float where
  display :: Float -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Float -> Builder) -> Float -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Builder
BB.floatDec
instance Display Double where
  display :: Double -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Double -> Builder) -> Double -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
BB.doubleDec

-- | @since 0.1.0.0
instance Display Int where
  display :: Int -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder) -> (Int -> Builder) -> Int -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
BB.intDec
-- | @since 0.1.0.0
instance Display Int8 where
  display :: Int8 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Int8 -> Builder) -> Int8 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Builder
BB.int8Dec
-- | @since 0.1.0.0
instance Display Int16 where
  display :: Int16 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Int16 -> Builder) -> Int16 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Builder
BB.int16Dec
-- | @since 0.1.0.0
instance Display Int32 where
  display :: Int32 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Int32 -> Builder) -> Int32 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Builder
BB.int32Dec
-- | @since 0.1.0.0
instance Display Int64 where
  display :: Int64 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Int64 -> Builder) -> Int64 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
BB.int64Dec

-- | @since 0.1.0.0
instance Display Word where
  display :: Word -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Word -> Builder) -> Word -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Builder
BB.wordDec
-- | @since 0.1.0.0
instance Display Word8 where
  display :: Word8 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Word8 -> Builder) -> Word8 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Builder
BB.word8Dec
-- | @since 0.1.0.0
instance Display Word16 where
  display :: Word16 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Word16 -> Builder) -> Word16 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Builder
BB.word16Dec
-- | @since 0.1.0.0
instance Display Word32 where
  display :: Word32 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Word32 -> Builder) -> Word32 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
BB.word32Dec
-- | @since 0.1.0.0
instance Display Word64 where
  display :: Word64 -> Utf8Builder
display = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (Word64 -> Builder) -> Word64 -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
BB.word64Dec

-- | @since 0.1.0.0
instance Display SomeException where
  display :: SomeException -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (SomeException -> String) -> SomeException -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException
-- | @since 0.1.0.0
instance Display IOException where
  display :: IOException -> Utf8Builder
display = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (IOException -> String) -> IOException -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> String
forall e. Exception e => e -> String
displayException

-- | @since 0.1.0.0
instance Display (ProcessConfig a b c) where
  display :: ProcessConfig a b c -> Utf8Builder
display = ProcessConfig a b c -> Utf8Builder
forall a. Show a => a -> Utf8Builder
displayShow (ProcessConfig a b c -> Utf8Builder)
-> (ProcessConfig a b c -> ProcessConfig a b c)
-> ProcessConfig a b c
-> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig a b c -> ProcessConfig a b c
forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setEnvInherit

-- | Use the 'Show' instance for a value to convert it to a
-- 'Utf8Builder'.
--
-- @since 0.1.0.0
displayShow :: Show a => a -> Utf8Builder
displayShow :: a -> Utf8Builder
displayShow = String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder) -> (a -> String) -> a -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Convert a 'ByteString' into a 'Utf8Builder'.
--
-- /NOTE/ This function performs no checks to ensure that the data is,
-- in fact, UTF8 encoded. If you provide non-UTF8 data, later
-- functions may fail.
--
-- @since 0.1.0.0
displayBytesUtf8 :: ByteString -> Utf8Builder
displayBytesUtf8 :: ByteString -> Utf8Builder
displayBytesUtf8 = Builder -> Utf8Builder
Utf8Builder (Builder -> Utf8Builder)
-> (ByteString -> Builder) -> ByteString -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BB.byteString

-- | Convert a 'Utf8Builder' value into a strict 'Text'.
--
-- @since 0.1.0.0
utf8BuilderToText :: Utf8Builder -> Text
utf8BuilderToText :: Utf8Builder -> Text
utf8BuilderToText =
  OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (Utf8Builder -> ByteString) -> Utf8Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Utf8Builder -> ByteString) -> Utf8Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Utf8Builder -> Builder) -> Utf8Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Builder
getUtf8Builder

-- | Convert a 'Utf8Builder' value into a lazy 'Text'.
--
-- @since 0.1.0.0
utf8BuilderToLazyText :: Utf8Builder -> TL.Text
utf8BuilderToLazyText :: Utf8Builder -> Text
utf8BuilderToLazyText =
  OnDecodeError -> ByteString -> Text
TL.decodeUtf8With OnDecodeError
lenientDecode (ByteString -> Text)
-> (Utf8Builder -> ByteString) -> Utf8Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Utf8Builder -> Builder) -> Utf8Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Builder
getUtf8Builder

-- | Write the given 'Utf8Builder' value to a file.
--
-- @since 0.1.0.0
writeFileUtf8Builder :: MonadIO m => FilePath -> Utf8Builder -> m ()
writeFileUtf8Builder :: String -> Utf8Builder -> m ()
writeFileUtf8Builder String
fp (Utf8Builder Builder
builder) =
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> IOMode -> (Handle -> m a) -> m a
withBinaryFile String
fp IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Builder -> IO ()
BB.hPutBuilder Handle
h Builder
builder