{-# LANGUAGE AllowAmbiguousTypes #-}

module Generic.Data.Function.Example where

import GHC.Generics
import Generic.Data.Function.FoldMap

import Data.List qualified as List

--data D a = D1 a | D2 a a deriving stock (Generic, Show)
data X = X1 | X2 deriving stock ((forall x. X -> Rep X x) -> (forall x. Rep X x -> X) -> Generic X
forall x. Rep X x -> X
forall x. X -> Rep X x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. X -> Rep X x
from :: forall x. X -> Rep X x
$cto :: forall x. Rep X x -> X
to :: forall x. Rep X x -> X
Generic)
data Y = Y deriving stock ((forall x. Y -> Rep Y x) -> (forall x. Rep Y x -> Y) -> Generic Y
forall x. Rep Y x -> Y
forall x. Y -> Rep Y x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Y -> Rep Y x
from :: forall x. Y -> Rep Y x
$cto :: forall x. Rep Y x -> Y
to :: forall x. Rep Y x -> Y
Generic)

newtype Showly = Showly { Showly -> [String]
unShowly :: [String] }
    --deriving Show via String
    deriving (NonEmpty Showly -> Showly
Showly -> Showly -> Showly
(Showly -> Showly -> Showly)
-> (NonEmpty Showly -> Showly)
-> (forall b. Integral b => b -> Showly -> Showly)
-> Semigroup Showly
forall b. Integral b => b -> Showly -> Showly
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Showly -> Showly -> Showly
<> :: Showly -> Showly -> Showly
$csconcat :: NonEmpty Showly -> Showly
sconcat :: NonEmpty Showly -> Showly
$cstimes :: forall b. Integral b => b -> Showly -> Showly
stimes :: forall b. Integral b => b -> Showly -> Showly
Semigroup, Semigroup Showly
Showly
Semigroup Showly =>
Showly
-> (Showly -> Showly -> Showly)
-> ([Showly] -> Showly)
-> Monoid Showly
[Showly] -> Showly
Showly -> Showly -> Showly
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Showly
mempty :: Showly
$cmappend :: Showly -> Showly -> Showly
mappend :: Showly -> Showly -> Showly
$cmconcat :: [Showly] -> Showly
mconcat :: [Showly] -> Showly
Monoid) via [String]

instance GenericFoldMap Showly where
    type GenericFoldMapC Showly a = Show a
    type GenericFoldMapM Showly = [String]
    genericFoldMapF :: forall a. GenericFoldMapC Showly a => a -> GenericFoldMapM Showly
genericFoldMapF = (\String
a -> [String
a]) (String -> [String]) -> (a -> String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

showGeneric
    :: forall a
    .  (Generic a, GFoldMapSum Showly (Rep a))
    => a -> String
showGeneric :: forall a. (Generic a, GFoldMapSum Showly (Rep a)) => a -> String
showGeneric =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> (a -> [String]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
" "
    ([String] -> [String]) -> (a -> [String]) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (tag :: k) a.
(Generic a, GFoldMapSum tag (Rep a)) =>
(String -> GenericFoldMapM tag) -> a -> GenericFoldMapM tag
forall tag a.
(Generic a, GFoldMapSum tag (Rep a)) =>
(String -> GenericFoldMapM tag) -> a -> GenericFoldMapM tag
genericFoldMapSum @Showly (\String
cstr -> [String
cstr])

showGeneric'
    :: forall a
    .  (Generic a, GFoldMapNonSum Showly (Rep a))
    => a -> String
showGeneric' :: forall a. (Generic a, GFoldMapNonSum Showly (Rep a)) => a -> String
showGeneric' =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String) -> (a -> [String]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
" " ([String] -> [String]) -> (a -> [String]) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (tag :: k) a.
(Generic a, GFoldMapNonSum tag (Rep a)) =>
a -> GenericFoldMapM tag
forall tag a.
(Generic a, GFoldMapNonSum tag (Rep a)) =>
a -> GenericFoldMapM tag
genericFoldMapNonSum @Showly