1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module RIO.Prelude.Display
3  ( Utf8Builder (..)
4  , Display (..)
5  , displayShow
6  , utf8BuilderToText
7  , utf8BuilderToLazyText
8  , displayBytesUtf8
9  , writeFileUtf8Builder
10  ) where
11
12import Data.String (IsString (..))
13import           Data.ByteString          (ByteString)
14import qualified Data.ByteString.Lazy     as BL
15import qualified Data.ByteString.Builder  as BB
16import           Data.ByteString.Builder  (Builder)
17import           Data.Semigroup           (Semigroup(..))
18import           Data.Text                (Text)
19import qualified Data.Text.Lazy           as TL
20import qualified Data.Text.Lazy.Encoding  as TL
21import UnliftIO
22import           Data.Text.Encoding       (decodeUtf8With, encodeUtf8Builder)
23import           Data.Text.Encoding.Error (lenientDecode)
24import           Data.Int
25import           Data.Word
26import           System.Process.Typed     (ProcessConfig, setEnvInherit)
27
28-- | A builder of binary data, with the invariant that the underlying
29-- data is supposed to be UTF-8 encoded.
30--
31-- @since 0.1.0.0
32newtype Utf8Builder = Utf8Builder { getUtf8Builder :: Builder }
33  deriving (Semigroup)
34
35-- Custom instance is created instead of deriving, otherwise list fusion breaks
36-- for `mconcat`.
37instance Monoid Utf8Builder where
38  mempty = Utf8Builder mempty
39  {-# INLINE mempty #-}
40  mappend = (Data.Semigroup.<>)
41  {-# INLINE mappend #-}
42  mconcat = foldr mappend mempty
43  {-# INLINE mconcat #-}
44
45-- | @since 0.1.0.0
46instance IsString Utf8Builder where
47  fromString = Utf8Builder . BB.stringUtf8
48
49-- | A typeclass for values which can be converted to a
50-- 'Utf8Builder'. The intention of this typeclass is to provide a
51-- human-friendly display of the data.
52--
53-- @since 0.1.0.0
54class Display a where
55  {-# MINIMAL display | textDisplay #-}
56
57  display :: a -> Utf8Builder
58  display = display . textDisplay
59
60  -- | Display data as `Text`, which will also be used for `display` if it is
61  -- not overriden.
62  --
63  -- @since 0.1.7.0
64  textDisplay :: a -> Text
65  textDisplay = utf8BuilderToText . display
66
67-- | @since 0.1.0.0
68instance Display Utf8Builder where
69  display = id
70-- | @since 0.1.0.0
71instance Display Text where
72  display = Utf8Builder . encodeUtf8Builder
73-- | @since 0.1.0.0
74instance Display TL.Text where
75  display = foldMap display . TL.toChunks
76-- | @since 0.1.0.0
77instance Display Char where
78  display = Utf8Builder . BB.charUtf8
79
80-- | @since 0.1.0.0
81instance Display Integer where
82  display = Utf8Builder . BB.integerDec
83-- | @since 0.1.0.0
84instance Display Float where
85  display = Utf8Builder . BB.floatDec
86instance Display Double where
87  display = Utf8Builder . BB.doubleDec
88
89-- | @since 0.1.0.0
90instance Display Int where
91  display = Utf8Builder . BB.intDec
92-- | @since 0.1.0.0
93instance Display Int8 where
94  display = Utf8Builder . BB.int8Dec
95-- | @since 0.1.0.0
96instance Display Int16 where
97  display = Utf8Builder . BB.int16Dec
98-- | @since 0.1.0.0
99instance Display Int32 where
100  display = Utf8Builder . BB.int32Dec
101-- | @since 0.1.0.0
102instance Display Int64 where
103  display = Utf8Builder . BB.int64Dec
104
105-- | @since 0.1.0.0
106instance Display Word where
107  display = Utf8Builder . BB.wordDec
108-- | @since 0.1.0.0
109instance Display Word8 where
110  display = Utf8Builder . BB.word8Dec
111-- | @since 0.1.0.0
112instance Display Word16 where
113  display = Utf8Builder . BB.word16Dec
114-- | @since 0.1.0.0
115instance Display Word32 where
116  display = Utf8Builder . BB.word32Dec
117-- | @since 0.1.0.0
118instance Display Word64 where
119  display = Utf8Builder . BB.word64Dec
120
121-- | @since 0.1.0.0
122instance Display SomeException where
123  display = fromString . displayException
124-- | @since 0.1.0.0
125instance Display IOException where
126  display = fromString . displayException
127
128-- | @since 0.1.0.0
129instance Display (ProcessConfig a b c) where
130  display = displayShow . setEnvInherit
131
132-- | Use the 'Show' instance for a value to convert it to a
133-- 'Utf8Builder'.
134--
135-- @since 0.1.0.0
136displayShow :: Show a => a -> Utf8Builder
137displayShow = fromString . show
138
139-- | Convert a 'ByteString' into a 'Utf8Builder'.
140--
141-- /NOTE/ This function performs no checks to ensure that the data is,
142-- in fact, UTF8 encoded. If you provide non-UTF8 data, later
143-- functions may fail.
144--
145-- @since 0.1.0.0
146displayBytesUtf8 :: ByteString -> Utf8Builder
147displayBytesUtf8 = Utf8Builder . BB.byteString
148
149-- | Convert a 'Utf8Builder' value into a strict 'Text'.
150--
151-- @since 0.1.0.0
152utf8BuilderToText :: Utf8Builder -> Text
153utf8BuilderToText =
154  decodeUtf8With lenientDecode . BL.toStrict . BB.toLazyByteString . getUtf8Builder
155
156-- | Convert a 'Utf8Builder' value into a lazy 'Text'.
157--
158-- @since 0.1.0.0
159utf8BuilderToLazyText :: Utf8Builder -> TL.Text
160utf8BuilderToLazyText =
161  TL.decodeUtf8With lenientDecode . BB.toLazyByteString . getUtf8Builder
162
163-- | Write the given 'Utf8Builder' value to a file.
164--
165-- @since 0.1.0.0
166writeFileUtf8Builder :: MonadIO m => FilePath -> Utf8Builder -> m ()
167writeFileUtf8Builder fp (Utf8Builder builder) =
168  liftIO $ withBinaryFile fp WriteMode $ \h -> BB.hPutBuilder h builder
169