module DebugPrint.Core
  ( DebugPrintRecord (..)
  , DebugPrintValue (..)
  , ToDebugPrintValue (..)
  , ToDebugPrintRecord (..)
  , ToDebugPrintValueRep
  , ToDebugPrintRecordRep
  , DebugInteger (..)
  , DebugShow (..)
  ) where

import Prelude

import Data.Aeson qualified as Aeson
import Data.Aeson.Key qualified as Aeson.Key
import Data.Aeson.KeyMap qualified as Aeson.KeyMap
import Data.Foldable (toList)
import Data.Int
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Scientific qualified as Scientific
import Data.Sequence (Seq)
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Vector (Vector)
import Data.Vector qualified as V
import Data.Word
import GHC.Generics
import Numeric.Natural (Natural)

newtype DebugPrintRecord = DebugPrintRecord (Map Text DebugPrintValue)
  deriving newtype (DebugPrintRecord -> DebugPrintRecord -> Bool
(DebugPrintRecord -> DebugPrintRecord -> Bool)
-> (DebugPrintRecord -> DebugPrintRecord -> Bool)
-> Eq DebugPrintRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugPrintRecord -> DebugPrintRecord -> Bool
== :: DebugPrintRecord -> DebugPrintRecord -> Bool
$c/= :: DebugPrintRecord -> DebugPrintRecord -> Bool
/= :: DebugPrintRecord -> DebugPrintRecord -> Bool
Eq, Semigroup DebugPrintRecord
DebugPrintRecord
Semigroup DebugPrintRecord =>
DebugPrintRecord
-> (DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord)
-> ([DebugPrintRecord] -> DebugPrintRecord)
-> Monoid DebugPrintRecord
[DebugPrintRecord] -> DebugPrintRecord
DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: DebugPrintRecord
mempty :: DebugPrintRecord
$cmappend :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
mappend :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
$cmconcat :: [DebugPrintRecord] -> DebugPrintRecord
mconcat :: [DebugPrintRecord] -> DebugPrintRecord
Monoid, Eq DebugPrintRecord
Eq DebugPrintRecord =>
(DebugPrintRecord -> DebugPrintRecord -> Ordering)
-> (DebugPrintRecord -> DebugPrintRecord -> Bool)
-> (DebugPrintRecord -> DebugPrintRecord -> Bool)
-> (DebugPrintRecord -> DebugPrintRecord -> Bool)
-> (DebugPrintRecord -> DebugPrintRecord -> Bool)
-> (DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord)
-> (DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord)
-> Ord DebugPrintRecord
DebugPrintRecord -> DebugPrintRecord -> Bool
DebugPrintRecord -> DebugPrintRecord -> Ordering
DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DebugPrintRecord -> DebugPrintRecord -> Ordering
compare :: DebugPrintRecord -> DebugPrintRecord -> Ordering
$c< :: DebugPrintRecord -> DebugPrintRecord -> Bool
< :: DebugPrintRecord -> DebugPrintRecord -> Bool
$c<= :: DebugPrintRecord -> DebugPrintRecord -> Bool
<= :: DebugPrintRecord -> DebugPrintRecord -> Bool
$c> :: DebugPrintRecord -> DebugPrintRecord -> Bool
> :: DebugPrintRecord -> DebugPrintRecord -> Bool
$c>= :: DebugPrintRecord -> DebugPrintRecord -> Bool
>= :: DebugPrintRecord -> DebugPrintRecord -> Bool
$cmax :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
max :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
$cmin :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
min :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
Ord, NonEmpty DebugPrintRecord -> DebugPrintRecord
DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
(DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord)
-> (NonEmpty DebugPrintRecord -> DebugPrintRecord)
-> (forall b.
    Integral b =>
    b -> DebugPrintRecord -> DebugPrintRecord)
-> Semigroup DebugPrintRecord
forall b. Integral b => b -> DebugPrintRecord -> DebugPrintRecord
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
<> :: DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
$csconcat :: NonEmpty DebugPrintRecord -> DebugPrintRecord
sconcat :: NonEmpty DebugPrintRecord -> DebugPrintRecord
$cstimes :: forall b. Integral b => b -> DebugPrintRecord -> DebugPrintRecord
stimes :: forall b. Integral b => b -> DebugPrintRecord -> DebugPrintRecord
Semigroup)

data DebugPrintValue
  = DebugPrintValueInt Integer
  | DebugPrintValueText Text
  | DebugPrintValueBool Bool
  | DebugPrintValueVector (Vector DebugPrintValue)
  | DebugPrintValueRecord DebugPrintRecord
  deriving stock (DebugPrintValue -> DebugPrintValue -> Bool
(DebugPrintValue -> DebugPrintValue -> Bool)
-> (DebugPrintValue -> DebugPrintValue -> Bool)
-> Eq DebugPrintValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugPrintValue -> DebugPrintValue -> Bool
== :: DebugPrintValue -> DebugPrintValue -> Bool
$c/= :: DebugPrintValue -> DebugPrintValue -> Bool
/= :: DebugPrintValue -> DebugPrintValue -> Bool
Eq, Eq DebugPrintValue
Eq DebugPrintValue =>
(DebugPrintValue -> DebugPrintValue -> Ordering)
-> (DebugPrintValue -> DebugPrintValue -> Bool)
-> (DebugPrintValue -> DebugPrintValue -> Bool)
-> (DebugPrintValue -> DebugPrintValue -> Bool)
-> (DebugPrintValue -> DebugPrintValue -> Bool)
-> (DebugPrintValue -> DebugPrintValue -> DebugPrintValue)
-> (DebugPrintValue -> DebugPrintValue -> DebugPrintValue)
-> Ord DebugPrintValue
DebugPrintValue -> DebugPrintValue -> Bool
DebugPrintValue -> DebugPrintValue -> Ordering
DebugPrintValue -> DebugPrintValue -> DebugPrintValue
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DebugPrintValue -> DebugPrintValue -> Ordering
compare :: DebugPrintValue -> DebugPrintValue -> Ordering
$c< :: DebugPrintValue -> DebugPrintValue -> Bool
< :: DebugPrintValue -> DebugPrintValue -> Bool
$c<= :: DebugPrintValue -> DebugPrintValue -> Bool
<= :: DebugPrintValue -> DebugPrintValue -> Bool
$c> :: DebugPrintValue -> DebugPrintValue -> Bool
> :: DebugPrintValue -> DebugPrintValue -> Bool
$c>= :: DebugPrintValue -> DebugPrintValue -> Bool
>= :: DebugPrintValue -> DebugPrintValue -> Bool
$cmax :: DebugPrintValue -> DebugPrintValue -> DebugPrintValue
max :: DebugPrintValue -> DebugPrintValue -> DebugPrintValue
$cmin :: DebugPrintValue -> DebugPrintValue -> DebugPrintValue
min :: DebugPrintValue -> DebugPrintValue -> DebugPrintValue
Ord)

instance IsString DebugPrintValue where
  fromString :: String -> DebugPrintValue
fromString = Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue)
-> (String -> Text) -> String -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

---

class ToDebugPrintValue a where
  toDebugPrintValue :: a -> DebugPrintValue
  default toDebugPrintValue
    :: (Generic a, ToDebugPrintRecordRep (Rep a)) => a -> DebugPrintValue
  toDebugPrintValue = DebugPrintRecord -> DebugPrintValue
DebugPrintValueRecord (DebugPrintRecord -> DebugPrintValue)
-> (a -> DebugPrintRecord) -> a -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a Any -> DebugPrintRecord
forall a. Rep a a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord (Rep a Any -> DebugPrintRecord)
-> (a -> Rep a Any) -> a -> DebugPrintRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

instance ToDebugPrintValue DebugPrintValue where
  toDebugPrintValue :: DebugPrintValue -> DebugPrintValue
toDebugPrintValue = DebugPrintValue -> DebugPrintValue
forall a. a -> a
id

instance ToDebugPrintValue DebugPrintRecord where
  toDebugPrintValue :: DebugPrintRecord -> DebugPrintValue
toDebugPrintValue = DebugPrintRecord -> DebugPrintValue
DebugPrintValueRecord

instance ToDebugPrintValue Integer where
  toDebugPrintValue :: Integer -> DebugPrintValue
toDebugPrintValue = Integer -> DebugPrintValue
DebugPrintValueInt

deriving via DebugInteger (Natural) instance ToDebugPrintValue Natural
deriving via DebugInteger (Int) instance ToDebugPrintValue Int
deriving via DebugInteger (Int8) instance ToDebugPrintValue Int8
deriving via DebugInteger (Int16) instance ToDebugPrintValue Int16
deriving via DebugInteger (Int32) instance ToDebugPrintValue Int32
deriving via DebugInteger (Int64) instance ToDebugPrintValue Int64
deriving via DebugInteger (Word) instance ToDebugPrintValue Word
deriving via DebugInteger (Word8) instance ToDebugPrintValue Word8
deriving via DebugInteger (Word16) instance ToDebugPrintValue Word16
deriving via DebugInteger (Word32) instance ToDebugPrintValue Word32
deriving via DebugInteger (Word64) instance ToDebugPrintValue Word64

instance ToDebugPrintValue Char where
  toDebugPrintValue :: Char -> DebugPrintValue
toDebugPrintValue = Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue)
-> (Char -> Text) -> Char -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

instance ToDebugPrintValue T.Text where
  toDebugPrintValue :: Text -> DebugPrintValue
toDebugPrintValue = Text -> DebugPrintValue
DebugPrintValueText

instance ToDebugPrintValue TL.Text where
  toDebugPrintValue :: Text -> DebugPrintValue
toDebugPrintValue = Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue)
-> (Text -> Text) -> Text -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict

instance ToDebugPrintValue Bool where
  toDebugPrintValue :: Bool -> DebugPrintValue
toDebugPrintValue = Bool -> DebugPrintValue
DebugPrintValueBool

instance ToDebugPrintValue a => ToDebugPrintValue (Maybe a) where
  toDebugPrintValue :: Maybe a -> DebugPrintValue
toDebugPrintValue = [a] -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue ([a] -> DebugPrintValue)
-> (Maybe a -> [a]) -> Maybe a -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> [a]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance ToDebugPrintValue a => ToDebugPrintValue [a] where
  toDebugPrintValue :: [a] -> DebugPrintValue
toDebugPrintValue = Vector a -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue (Vector a -> DebugPrintValue)
-> ([a] -> Vector a) -> [a] -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList

instance ToDebugPrintValue a => ToDebugPrintValue (NonEmpty a) where
  toDebugPrintValue :: NonEmpty a -> DebugPrintValue
toDebugPrintValue = [a] -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue ([a] -> DebugPrintValue)
-> (NonEmpty a -> [a]) -> NonEmpty a -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance ToDebugPrintValue a => ToDebugPrintValue (Seq a) where
  toDebugPrintValue :: Seq a -> DebugPrintValue
toDebugPrintValue = [a] -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue ([a] -> DebugPrintValue)
-> (Seq a -> [a]) -> Seq a -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance ToDebugPrintValue a => ToDebugPrintValue (Vector a) where
  toDebugPrintValue :: Vector a -> DebugPrintValue
toDebugPrintValue = Vector DebugPrintValue -> DebugPrintValue
DebugPrintValueVector (Vector DebugPrintValue -> DebugPrintValue)
-> (Vector a -> Vector DebugPrintValue)
-> Vector a
-> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> DebugPrintValue) -> Vector a -> Vector DebugPrintValue
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue

instance ToDebugPrintValue Aeson.Key where
  toDebugPrintValue :: Key -> DebugPrintValue
toDebugPrintValue = Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue)
-> (Key -> Text) -> Key -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
Aeson.Key.toText

instance ToDebugPrintValue Aeson.Value where
  toDebugPrintValue :: Value -> DebugPrintValue
toDebugPrintValue = \case
    Aeson.Object Object
x -> DebugPrintRecord -> DebugPrintValue
DebugPrintValueRecord (DebugPrintRecord -> DebugPrintValue)
-> DebugPrintRecord -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ Object -> DebugPrintRecord
forall a. ToDebugPrintRecord a => a -> DebugPrintRecord
toDebugPrintRecord Object
x
    Aeson.Array Array
x -> Vector DebugPrintValue -> DebugPrintValue
DebugPrintValueVector (Vector DebugPrintValue -> DebugPrintValue)
-> Vector DebugPrintValue -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ (Value -> DebugPrintValue) -> Array -> Vector DebugPrintValue
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue Array
x
    Aeson.String Text
x -> Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue) -> Text -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"(string)", Text
x]
    Aeson.Number Scientific
x ->
      -- Since JSON numbers support scientific notation, an exponential form may
      -- represent an unreasonably large integer. Int64 is an arbitrary limit on
      -- the size of integer we're willing to expand.
      case forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger @Int64 Scientific
x of
        Just Int64
i -> Integer -> DebugPrintValue
DebugPrintValueInt (Integer -> DebugPrintValue) -> Integer -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
i
        Maybe Int64
Nothing -> Text -> DebugPrintValue
DebugPrintValueText (Text -> DebugPrintValue) -> Text -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords [Text
"(number)", String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
x]
    Aeson.Bool Bool
x -> Bool -> DebugPrintValue
DebugPrintValueBool Bool
x
    Value
Aeson.Null -> Text -> DebugPrintValue
DebugPrintValueText Text
"(null)"

instance ToDebugPrintValue Aeson.Object where
  toDebugPrintValue :: Object -> DebugPrintValue
toDebugPrintValue = DebugPrintRecord -> DebugPrintValue
DebugPrintValueRecord (DebugPrintRecord -> DebugPrintValue)
-> (Object -> DebugPrintRecord) -> Object -> DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> DebugPrintRecord
forall a. ToDebugPrintRecord a => a -> DebugPrintRecord
toDebugPrintRecord

---

class ToDebugPrintRecord a where
  toDebugPrintRecord :: a -> DebugPrintRecord
  default toDebugPrintRecord
    :: (Generic a, ToDebugPrintRecordRep (Rep a)) => a -> DebugPrintRecord
  toDebugPrintRecord = Rep a Any -> DebugPrintRecord
forall a. Rep a a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord (Rep a Any -> DebugPrintRecord)
-> (a -> Rep a Any) -> a -> DebugPrintRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

instance ToDebugPrintRecord DebugPrintRecord where
  toDebugPrintRecord :: DebugPrintRecord -> DebugPrintRecord
toDebugPrintRecord = DebugPrintRecord -> DebugPrintRecord
forall a. a -> a
id

instance ToDebugPrintRecord Aeson.Object where
  toDebugPrintRecord :: Object -> DebugPrintRecord
toDebugPrintRecord = Map Text DebugPrintValue -> DebugPrintRecord
DebugPrintRecord (Map Text DebugPrintValue -> DebugPrintRecord)
-> (Object -> Map Text DebugPrintValue)
-> Object
-> DebugPrintRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> DebugPrintValue)
-> Map Text Value -> Map Text DebugPrintValue
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue (Map Text Value -> Map Text DebugPrintValue)
-> (Object -> Map Text Value) -> Object -> Map Text DebugPrintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Map Text Value
forall v. KeyMap v -> Map Text v
Aeson.KeyMap.toMapText

---

class ToDebugPrintValueRep (f :: Type -> Type) where
  gToValue :: f a -> DebugPrintValue

instance ToDebugPrintValue a => ToDebugPrintValueRep (K1 i a) where
  gToValue :: forall a. K1 i a a -> DebugPrintValue
gToValue (K1 a
x) = a -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue a
x

---

class ToDebugPrintRecordRep (f :: Type -> Type) where
  gToRecord :: f a -> DebugPrintRecord

instance ToDebugPrintRecordRep U1 where
  gToRecord :: forall a. U1 a -> DebugPrintRecord
gToRecord U1 a
_ = Map Text DebugPrintValue -> DebugPrintRecord
DebugPrintRecord Map Text DebugPrintValue
forall a. Monoid a => a
mempty

instance
  (ToDebugPrintRecordRep f, ToDebugPrintRecordRep g)
  => ToDebugPrintRecordRep (f :*: g)
  where
  gToRecord :: forall a. (:*:) f g a -> DebugPrintRecord
gToRecord (f a
x :*: g a
y) = f a -> DebugPrintRecord
forall a. f a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord f a
x DebugPrintRecord -> DebugPrintRecord -> DebugPrintRecord
forall a. Semigroup a => a -> a -> a
<> g a -> DebugPrintRecord
forall a. g a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord g a
y

instance ToDebugPrintRecordRep f => ToDebugPrintRecordRep (D1 i f) where
  gToRecord :: forall a. D1 i f a -> DebugPrintRecord
gToRecord (M1 f a
x) = f a -> DebugPrintRecord
forall a. f a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord f a
x

instance ToDebugPrintRecordRep f => ToDebugPrintRecordRep (C1 i f) where
  gToRecord :: forall a. C1 i f a -> DebugPrintRecord
gToRecord (M1 f a
x) = f a -> DebugPrintRecord
forall a. f a -> DebugPrintRecord
forall (f :: * -> *) a.
ToDebugPrintRecordRep f =>
f a -> DebugPrintRecord
gToRecord f a
x

instance (Selector s, ToDebugPrintValueRep f) => ToDebugPrintRecordRep (S1 s f) where
  gToRecord :: forall a. S1 s f a -> DebugPrintRecord
gToRecord s1 :: S1 s f a
s1@(M1 f a
x) = Map Text DebugPrintValue -> DebugPrintRecord
DebugPrintRecord (Map Text DebugPrintValue -> DebugPrintRecord)
-> Map Text DebugPrintValue -> DebugPrintRecord
forall a b. (a -> b) -> a -> b
$ case f a -> DebugPrintValue
forall a. f a -> DebugPrintValue
forall (f :: * -> *) a.
ToDebugPrintValueRep f =>
f a -> DebugPrintValue
gToValue f a
x of
    DebugPrintValueText Text
y | Text -> Bool
T.null Text
y -> Map Text DebugPrintValue
forall k a. Map k a
Map.empty
    DebugPrintValueVector Vector DebugPrintValue
y | Vector DebugPrintValue -> Bool
forall a. Vector a -> Bool
V.null Vector DebugPrintValue
y -> Map Text DebugPrintValue
forall k a. Map k a
Map.empty
    DebugPrintValueRecord (DebugPrintRecord Map Text DebugPrintValue
y) | Map Text DebugPrintValue -> Bool
forall k a. Map k a -> Bool
Map.null Map Text DebugPrintValue
y -> Map Text DebugPrintValue
forall k a. Map k a
Map.empty
    DebugPrintValue
y -> Text -> DebugPrintValue -> Map Text DebugPrintValue
forall k a. k -> a -> Map k a
Map.singleton (String -> Text
T.pack (S1 s f a -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName S1 s f a
s1)) DebugPrintValue
y

---

-- | For use with deriving-via, provides a simple 'ToDebugPrintValue'
--   instance based on 'Show' which renders as text
newtype DebugShow a = DebugShow a

instance Show a => ToDebugPrintValue (DebugShow a) where
  toDebugPrintValue :: DebugShow a -> DebugPrintValue
toDebugPrintValue (DebugShow a
x) =
    Text -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue (Text -> DebugPrintValue) -> Text -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x

---

-- | For use with deriving-via, provides a simple 'ToDebugPrintValue'
--   instance based on 'toInteger' which renders as an integer
newtype DebugInteger a = DebugInteger a

instance Integral a => ToDebugPrintValue (DebugInteger a) where
  toDebugPrintValue :: DebugInteger a -> DebugPrintValue
toDebugPrintValue (DebugInteger a
x) =
    Integer -> DebugPrintValue
forall a. ToDebugPrintValue a => a -> DebugPrintValue
toDebugPrintValue (Integer -> DebugPrintValue) -> Integer -> DebugPrintValue
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x