module Generic.Data.Function.Example where

import GHC.Generics ( Generic )
import Generic.Data.Function.FoldMap.Constructor ( GenericFoldMap(..) )

data D a = D1 a | D2 a a deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (D a) x -> D a
forall a x. D a -> Rep (D a) x
$cto :: forall a x. Rep (D a) x -> D a
$cfrom :: forall a x. D a -> Rep (D a) x
Generic, Int -> D a -> ShowS
forall a. Show a => Int -> D a -> ShowS
forall a. Show a => [D a] -> ShowS
forall a. Show a => D a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [D a] -> ShowS
$cshowList :: forall a. Show a => [D a] -> ShowS
show :: D a -> String
$cshow :: forall a. Show a => D a -> String
showsPrec :: Int -> D a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> D a -> ShowS
Show)

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

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