{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Text.PrettyPrint.GenericPretty.Instance
(
)
where
import qualified Control.Exception as Exception
import qualified Crypto.Secp256k1 as Secp256k1
import Data.ByteString.Base16 as B16 (encode)
import qualified Data.CaseInsensitive as CI
import qualified Data.Fixed as Fixed
import qualified Data.ProtoLens.Runtime.Data.ProtoLens.Encoding.Wire as Wire
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Time.Calendar as Calendar
import Data.Time.Clock (UTCTime)
import qualified Data.Time.Clock as Clock
import qualified Data.Time.LocalTime as LocalTime
import qualified Data.Vector.Unboxed as Unboxed
import qualified Database.Persist as Psql
import qualified GHC.Conc.Sync as GHC
import Text.PrettyPrint.GenericPretty
import Universum
deriving stock instance Generic Wire.Tag
instance Out Wire.Tag
deriving stock instance Generic Wire.WireValue
instance Out Wire.WireValue
deriving stock instance Generic Wire.TaggedValue
instance Out Wire.TaggedValue
deriving stock instance Generic Exception.BlockedIndefinitelyOnMVar
instance Out Exception.BlockedIndefinitelyOnMVar
deriving stock instance Generic Calendar.Day
instance Out Calendar.Day
deriving stock instance Generic LocalTime.TimeOfDay
instance Out LocalTime.TimeOfDay
deriving stock instance Generic UTCTime
instance Out UTCTime
deriving stock instance Generic (Fixed.Fixed a)
instance Out (Fixed.Fixed a)
deriving stock instance Generic Psql.PersistValue
instance Out Psql.PersistValue
deriving stock instance Generic Psql.LiteralType
instance Out Psql.LiteralType
instance
( Generic a,
Generic (Psql.Key a),
Out a,
Out (Psql.Key a)
) =>
Out (Psql.Entity a)
instance Out Secp256k1.PubKey
instance Out Secp256k1.Sig
instance (Out a) => Out (CI.CI a) where
docPrec :: Int -> CI a -> Doc
docPrec Int
x = Int -> a -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
x (a -> Doc) -> (CI a -> a) -> CI a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI a -> a
forall s. CI s -> s
CI.original
doc :: CI a -> Doc
doc = a -> Doc
forall a. Out a => a -> Doc
doc (a -> Doc) -> (CI a -> a) -> CI a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI a -> a
forall s. CI s -> s
CI.original
instance Out GHC.ThreadId where
docPrec :: Int -> ThreadId -> Doc
docPrec = (ThreadId -> Doc) -> Int -> ThreadId -> Doc
forall a b. a -> b -> a
const ThreadId -> Doc
forall b a. (Show a, IsString b) => a -> b
Universum.show
doc :: ThreadId -> Doc
doc = ThreadId -> Doc
forall b a. (Show a, IsString b) => a -> b
Universum.show
instance Out Clock.DiffTime where
docPrec :: Int -> DiffTime -> Doc
docPrec = (DiffTime -> Doc) -> Int -> DiffTime -> Doc
forall a b. a -> b -> a
const DiffTime -> Doc
forall b a. (Show a, IsString b) => a -> b
Universum.show
doc :: DiffTime -> Doc
doc = DiffTime -> Doc
forall b a. (Show a, IsString b) => a -> b
Universum.show
instance Out Word32 where
docPrec :: Int -> Word32 -> Doc
docPrec Int
n = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Integer -> Doc) -> (Word32 -> Integer) -> Word32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Integer
doc :: Word32 -> Doc
doc = Integer -> Doc
forall a. Out a => a -> Doc
doc (Integer -> Doc) -> (Word32 -> Integer) -> Word32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Integer
instance Out Word64 where
docPrec :: Int -> Word64 -> Doc
docPrec Int
n = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Integer -> Doc) -> (Word64 -> Integer) -> Word64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Integer
doc :: Word64 -> Doc
doc = Integer -> Doc
forall a. Out a => a -> Doc
doc (Integer -> Doc) -> (Word64 -> Integer) -> Word64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Integer
instance Out Int32 where
docPrec :: Int -> Int32 -> Doc
docPrec Int
n = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Integer -> Doc) -> (Int32 -> Integer) -> Int32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Integer
doc :: Int32 -> Doc
doc = Integer -> Doc
forall a. Out a => a -> Doc
doc (Integer -> Doc) -> (Int32 -> Integer) -> Int32 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Integer
instance Out Int64 where
docPrec :: Int -> Int64 -> Doc
docPrec Int
n = Int -> Integer -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (Integer -> Doc) -> (Int64 -> Integer) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer
doc :: Int64 -> Doc
doc = Integer -> Doc
forall a. Out a => a -> Doc
doc (Integer -> Doc) -> (Int64 -> Integer) -> Int64 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Integer
instance Out Text where
docPrec :: Int -> Text -> Doc
docPrec Int
n = Int -> String -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
doc :: Text -> Doc
doc = String -> Doc
forall a. Out a => a -> Doc
doc (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
instance Out TL.Text where
docPrec :: Int -> Text -> Doc
docPrec Int
n = Int -> String -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
doc :: Text -> Doc
doc = String -> Doc
forall a. Out a => a -> Doc
doc (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
instance Out ByteString where
docPrec :: Int -> ByteString -> Doc
docPrec Int
n = Int -> ByteStringDoc -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n (ByteStringDoc -> Doc)
-> (ByteString -> ByteStringDoc) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringDoc
newBsDoc
doc :: ByteString -> Doc
doc = ByteStringDoc -> Doc
forall a. Out a => a -> Doc
doc (ByteStringDoc -> Doc)
-> (ByteString -> ByteStringDoc) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStringDoc
newBsDoc
instance (Out a) => Out (Vector a) where
docPrec :: Int -> Vector a -> Doc
docPrec Int
n = Int -> [a] -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall t. Container t => t -> [Element t]
toList
doc :: Vector a -> Doc
doc = [a] -> Doc
forall a. Out a => a -> Doc
doc ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall t. Container t => t -> [Element t]
toList
instance
(Out a, Unboxed.Unbox a) =>
Out (Unboxed.Vector a)
where
docPrec :: Int -> Vector a -> Doc
docPrec Int
n = Int -> [a] -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
Unboxed.toList
doc :: Vector a -> Doc
doc = [a] -> Doc
forall a. Out a => a -> Doc
doc ([a] -> Doc) -> (Vector a -> [a]) -> Vector a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Unbox a => Vector a -> [a]
Unboxed.toList
instance (Out a, Out b) => Out (Map a b) where
docPrec :: Int -> Map a b -> Doc
docPrec Int
n = Int -> [b] -> Doc
forall a. Out a => Int -> a -> Doc
docPrec Int
n ([b] -> Doc) -> (Map a b -> [b]) -> Map a b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [b]
forall t. Container t => t -> [Element t]
toList
doc :: Map a b -> Doc
doc = [b] -> Doc
forall a. Out a => a -> Doc
doc ([b] -> Doc) -> (Map a b -> [b]) -> Map a b -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [b]
forall t. Container t => t -> [Element t]
toList
data ByteStringDoc
= ByteStringUtf8 Text
| ByteStringHex Text
| ByteStringRaw Text
deriving stock ((forall x. ByteStringDoc -> Rep ByteStringDoc x)
-> (forall x. Rep ByteStringDoc x -> ByteStringDoc)
-> Generic ByteStringDoc
forall x. Rep ByteStringDoc x -> ByteStringDoc
forall x. ByteStringDoc -> Rep ByteStringDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ByteStringDoc x -> ByteStringDoc
$cfrom :: forall x. ByteStringDoc -> Rep ByteStringDoc x
Generic)
instance Out ByteStringDoc
newBsDoc :: ByteString -> ByteStringDoc
newBsDoc :: ByteString -> ByteStringDoc
newBsDoc ByteString
bs =
case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bs of
Right Text
txt -> Text -> ByteStringDoc
ByteStringUtf8 Text
txt
Left {} ->
case ByteString -> Either UnicodeException Text
decodeUtf8' (ByteString -> Either UnicodeException Text)
-> ByteString -> Either UnicodeException Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode ByteString
bs of
Right Text
txt -> Text -> ByteStringDoc
ByteStringHex Text
txt
Left {} -> Text -> ByteStringDoc
ByteStringRaw (Text -> ByteStringDoc) -> Text -> ByteStringDoc
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall b a. (Show a, IsString b) => a -> b
Universum.show ByteString
bs