{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module TextShow.Data.Monoid () where
import Data.Monoid (All, Alt, Any, Dual, First, Last, Product, Sum)
import TextShow.Classes (TextShow(..))
import TextShow.Data.Bool ()
import TextShow.Data.Maybe ()
import TextShow.TH.Internal (deriveTextShow, deriveTextShow1, makeShowbPrec)
#if MIN_VERSION_base(4,12,0)
import Data.Monoid (Ap)
#endif
$(deriveTextShow ''All)
$(deriveTextShow ''Any)
$(deriveTextShow ''Dual)
$(deriveTextShow1 ''Dual)
$(deriveTextShow ''First)
$(deriveTextShow1 ''First)
$(deriveTextShow ''Last)
$(deriveTextShow1 ''Last)
$(deriveTextShow ''Product)
$(deriveTextShow1 ''Product)
$(deriveTextShow ''Sum)
$(deriveTextShow1 ''Sum)
instance TextShow (f a) => TextShow (Alt f a) where
showbPrec :: Int -> Alt f a -> Builder
showbPrec = $(makeShowbPrec ''Alt)
$(deriveTextShow1 ''Alt)
#if MIN_VERSION_base(4,12,0)
instance TextShow (f a) => TextShow (Ap f a) where
showbPrec :: Int -> Ap f a -> Builder
showbPrec = $(makeShowbPrec ''Ap)
$(deriveTextShow1 ''Ap)
#endif