{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module Data.Record.Generic.Show (
    gshowsPrec
  ) where

import Data.Record.Generic
import Data.List (intersperse)
import GHC.Show

import qualified Data.Record.Generic.Rep as Rep

-- | Generic definition of 'showsPrec', compatible with the GHC generated one.
--
-- Typical usage:
--
-- > instance Show T where
-- >   showsPrec = gshowsPrec
gshowsPrec :: forall a. (Generic a, Constraints a Show) => Int -> a -> ShowS
gshowsPrec :: Int -> a -> ShowS
gshowsPrec Int
d =
      [ShowS] -> ShowS
aux
    ([ShowS] -> ShowS) -> (a -> [ShowS]) -> a -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (K ShowS) a -> [ShowS]
forall a b. Rep (K a) b -> [a]
Rep.collapse
    (Rep (K ShowS) a -> [ShowS])
-> (a -> Rep (K ShowS) a) -> a -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy Show
-> (forall x. Show x => K String x -> I x -> K ShowS x)
-> Rep (K String) a
-> Rep I a
-> Rep (K ShowS) a
forall a (c :: Type -> Constraint) (f :: Type -> Type)
       (g :: Type -> Type) (h :: Type -> Type).
(Generic a, Constraints a c) =>
Proxy c
-> (forall x. c x => f x -> g x -> h x)
-> Rep f a
-> Rep g a
-> Rep h a
Rep.czipWith (Proxy Show
forall k (t :: k). Proxy t
Proxy @Show) forall x. Show x => K String x -> I x -> K ShowS x
showField (Metadata a -> Rep (K String) a
forall a. Metadata a -> Rep (K String) a
recordFieldNames Metadata a
md)
    (Rep I a -> Rep (K ShowS) a)
-> (a -> Rep I a) -> a -> Rep (K ShowS) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep I a
forall a. Generic a => a -> Rep I a
from
  where
    md :: Metadata a
md = Proxy a -> Metadata a
forall a (proxy :: Type -> Type).
Generic a =>
proxy a -> Metadata a
metadata (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

    showField :: Show x => K String x -> I x -> K ShowS x
    showField :: K String x -> I x -> K ShowS x
showField (K String
n) (I x
x) = ShowS -> K ShowS x
forall k a (b :: k). a -> K a b
K (ShowS -> K ShowS x) -> ShowS -> K ShowS x
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> x -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 x
x

    aux :: [ShowS] -> ShowS
    aux :: [ShowS] -> ShowS
aux [ShowS]
fields = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (
          String -> ShowS
showString (Metadata a -> String
forall a. Metadata a -> String
recordConstructor Metadata a
md) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" {"
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse ShowS
showCommaSpace [ShowS]
fields)
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}"
        )