-- | Generic show.
--
-- This module contains a generic show function defined using
-- @generics-sop@.
--
module Generics.SOP.Show (gshowsPrec, gshow) where

import Data.List (intersperse)

import Generics.SOP

-- | Generic show.
--
-- This function is a proof-of-concept implementation of a function
-- that is similar to the 'show' function you get by using
-- 'deriving Show'.
--
-- It serves as an example of an SOP-style generic function that makes
-- use of metadata.
--
-- If you want to use it on a datatype @T@ for which you have a
-- 'Generics.SOP.Generic' instance, you can use 'gshowsPrec' as
-- follows:
--
-- > instance Show T where
-- >   showsPrec = gshowsPrec
--
gshowsPrec :: forall a. (Generic a, HasDatatypeInfo a, All2 Show (Code a))
           => Int -> a -> ShowS
gshowsPrec :: forall a.
(Generic a, HasDatatypeInfo a, All2 Show (Code a)) =>
Int -> a -> ShowS
gshowsPrec Int
prec a
a =
  forall (xss :: [[*]]).
(All2 Show xss, SListI xss) =>
Int -> NP ConstructorInfo xss -> SOP I xss -> ShowS
gshowsPrec' Int
prec (forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
constructorInfo (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
datatypeInfo (forall {k} (t :: k). Proxy t
Proxy :: Proxy a))) (forall a. Generic a => a -> Rep a
from a
a)

gshow :: (Generic a, HasDatatypeInfo a, All2 Show (Code a)) => a -> String
gshow :: forall a.
(Generic a, HasDatatypeInfo a, All2 Show (Code a)) =>
a -> String
gshow a
a = forall a.
(Generic a, HasDatatypeInfo a, All2 Show (Code a)) =>
Int -> a -> ShowS
gshowsPrec Int
0 a
a String
""

gshowsPrec' :: (All2 Show xss, SListI xss) => Int -> NP ConstructorInfo xss -> SOP I xss -> ShowS
gshowsPrec' :: forall (xss :: [[*]]).
(All2 Show xss, SListI xss) =>
Int -> NP ConstructorInfo xss -> SOP I xss -> ShowS
gshowsPrec' Int
prec NP ConstructorInfo xss
cs (SOP NS (NP I) xss
sop) =
  forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall a b. (a -> b) -> a -> b
$ forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2 Proxy (All Show)
allp (forall (xs :: [*]).
All Show xs =>
Int -> ConstructorInfo xs -> NP I xs -> K ShowS xs
goConstructor Int
prec) NP ConstructorInfo xss
cs NS (NP I) xss
sop

goConstructor :: All Show xs => Int -> ConstructorInfo xs -> NP I xs -> K ShowS xs
goConstructor :: forall (xs :: [*]).
All Show xs =>
Int -> ConstructorInfo xs -> NP I xs -> K ShowS xs
goConstructor Int
prec (Constructor String
n) NP I xs
args =
    forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$
      Bool -> ShowS -> ShowS
showParen
        (Int
fixity forall a. Ord a => a -> a -> Bool
<= Int
prec)
        (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
" ") (String -> ShowS
showString String
n forall a. a -> [a] -> [a]
: [ShowS]
args'))
  where
    args' :: [ShowS]
    args' :: [ShowS]
args' = forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall a b. (a -> b) -> a -> b
$ forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcliftA Proxy Show
p (forall k a (b :: k). a -> K a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. I a -> a
unI) NP I xs
args

    -- With fixity = 11 the parens will be shown only if the enclosing
    -- context is a function application.  This is correct because
    -- function application is the only thing that binds tightly
    -- enough to force parens around this expression.
    fixity :: Int
fixity = Int
11

goConstructor Int
prec (Record String
n NP FieldInfo xs
ns) NP I xs
args =
    forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$
      Bool -> ShowS -> ShowS
showParen
        (Int
fixity forall a. Ord a => a -> a -> Bool
<= Int
prec)
        (String -> ShowS
showString String
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" {" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id (forall a. a -> [a] -> [a]
intersperse (String -> ShowS
showString String
", ") [ShowS]
args') forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"}")
  where
    args' :: [ShowS]
    args' :: [ShowS]
args' = forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall a b. (a -> b) -> a -> b
$ forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hcliftA2 Proxy Show
p forall a. Show a => FieldInfo a -> I a -> K ShowS a
goField NP FieldInfo xs
ns NP I xs
args

    -- With fixity = 12 the parens will never be shown.  This is
    -- correct because record construction binds tighter than even
    -- function application!
    fixity :: Int
fixity = Int
12

goConstructor Int
prec (Infix String
n Associativity
_ Int
fixity) (I x
arg1 :* I x
arg2 :* NP I xs
Nil) =
    forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$
      Bool -> ShowS -> ShowS
showParen
        (Int
fixity forall a. Ord a => a -> a -> Bool
<= Int
prec)
        (forall a. Show a => Int -> a -> ShowS
showsPrec Int
fixity x
arg1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
fixity x
arg2)
#if __GLASGOW_HASKELL__ < 800
goConstructor _ (Infix _ _ _) _ = error "inaccessible"
#endif

goField :: Show a => FieldInfo a -> I a -> K ShowS a
goField :: forall a. Show a => FieldInfo a -> I a -> K ShowS a
goField (FieldInfo String
field) (I a
a) = forall k a (b :: k). a -> K a b
K forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
field forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" = " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 a
a

p :: Proxy Show
p :: Proxy Show
p = forall {k} (t :: k). Proxy t
Proxy

allp :: Proxy (All Show)
allp :: Proxy (All Show)
allp = forall {k} (t :: k). Proxy t
Proxy