{-# 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

--
-- Trivial
--

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

--
-- Show
--

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

--
-- Composite
--

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

--
-- Misc
--

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