{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.GHC.Generics () where
import Generics.Deriving.Base
import TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..))
import TextShow.Data.Char ()
import TextShow.Data.Floating ()
import TextShow.Data.Integral ()
import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec,
makeLiftShowbPrec, makeLiftShowbPrec2)
$(deriveTextShow1 ''U1)
instance TextShow (U1 p) where
showbPrec :: Int -> U1 p -> Builder
showbPrec = (Int -> p -> Builder) -> ([p] -> Builder) -> Int -> U1 p -> Builder
forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec Int -> p -> Builder
forall a. HasCallStack => a
undefined [p] -> Builder
forall a. HasCallStack => a
undefined
$(deriveTextShow ''Par1)
$(deriveTextShow1 ''Par1)
instance TextShow (f p) => TextShow (Rec1 f p) where
showbPrec :: Int -> Rec1 f p -> Builder
showbPrec = $(makeShowbPrec ''Rec1)
$(deriveTextShow1 ''Rec1)
instance TextShow c => TextShow (K1 i c p) where
showbPrec :: Int -> K1 i c p -> Builder
showbPrec = (Int -> p -> Builder)
-> ([p] -> Builder) -> Int -> K1 i c p -> Builder
forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec Int -> p -> Builder
forall a. HasCallStack => a
undefined [p] -> Builder
forall a. HasCallStack => a
undefined
instance TextShow c => TextShow1 (K1 i c) where
liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> K1 i c a -> Builder
liftShowbPrec = (Int -> c -> Builder)
-> ([c] -> Builder)
-> (Int -> a -> Builder)
-> ([a] -> Builder)
-> Int
-> K1 i c a
-> Builder
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 Int -> c -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec [c] -> Builder
forall a. TextShow a => [a] -> Builder
showbList
instance TextShow2 (K1 i) where
liftShowbPrec2 :: (Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> K1 i a b
-> Builder
liftShowbPrec2 = $(makeLiftShowbPrec2 ''K1)
instance TextShow (f p) => TextShow (M1 i c f p) where
showbPrec :: Int -> M1 i c f p -> Builder
showbPrec = $(makeShowbPrec ''M1)
instance TextShow1 f => TextShow1 (M1 i c f) where
liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> M1 i c f a -> Builder
liftShowbPrec = $(makeLiftShowbPrec ''M1)
instance (TextShow (f p), TextShow (g p)) => TextShow ((f :+: g) p) where
showbPrec :: Int -> (:+:) f g p -> Builder
showbPrec = $(makeShowbPrec ''(:+:))
$(deriveTextShow1 ''(:+:))
instance (TextShow (f p), TextShow (g p)) => TextShow ((f :*: g) p) where
showbPrec :: Int -> (:*:) f g p -> Builder
showbPrec = $(makeShowbPrec ''(:*:))
$(deriveTextShow1 ''(:*:))
instance TextShow (f (g p)) => TextShow ((f :.: g) p) where
showbPrec :: Int -> (:.:) f g p -> Builder
showbPrec = $(makeShowbPrec ''(:.:))
$(deriveTextShow1 ''(:.:))
instance TextShow (UChar p) where
showbPrec :: Int -> UChar p -> Builder
showbPrec = $(makeShowbPrec 'UChar)
$(deriveTextShow1 'UChar)
instance TextShow (UDouble p) where
showbPrec :: Int -> UDouble p -> Builder
showbPrec = $(makeShowbPrec 'UDouble)
$(deriveTextShow1 'UDouble)
instance TextShow (UFloat p) where
showbPrec :: Int -> UFloat p -> Builder
showbPrec = $(makeShowbPrec 'UFloat)
$(deriveTextShow1 'UFloat)
instance TextShow (UInt p) where
showbPrec :: Int -> UInt p -> Builder
showbPrec = $(makeShowbPrec 'UInt)
$(deriveTextShow1 'UInt)
instance TextShow (UWord p) where
showbPrec :: Int -> UWord p -> Builder
showbPrec = $(makeShowbPrec 'UWord)
$(deriveTextShow1 'UWord)
$(deriveTextShow ''Associativity)
$(deriveTextShow ''Fixity)
#if MIN_VERSION_base(4,9,0)
$(deriveTextShow ''SourceUnpackedness)
$(deriveTextShow ''SourceStrictness)
$(deriveTextShow ''DecidedStrictness)
#else
$(deriveTextShow ''Arity)
#endif