{-# LANGUAGE CPP #-}
#if MIN_VERSION_base(4,8,1)
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif
module TextShow.GHC.Stack () where
#if MIN_VERSION_base(4,8,1)
import GHC.Stack (CallStack)
# if MIN_VERSION_base(4,9,0)
import GHC.Stack (SrcLoc, getCallStack)
import TextShow.Classes (TextShow(..))
# else
import GHC.SrcLoc (SrcLoc)
# endif
import TextShow.Data.Char ()
import TextShow.Data.Integral ()
import TextShow.Data.List ()
import TextShow.Data.Tuple ()
import TextShow.TH.Internal (deriveTextShow)
$(deriveTextShow ''SrcLoc)
# if MIN_VERSION_base(4,9,0)
instance TextShow CallStack where
showb :: CallStack -> Builder
showb = [([Char], SrcLoc)] -> Builder
forall a. TextShow a => a -> Builder
showb ([([Char], SrcLoc)] -> Builder)
-> (CallStack -> [([Char], SrcLoc)]) -> CallStack -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [([Char], SrcLoc)]
getCallStack
{-# INLINE showb #-}
# else
$(deriveTextShow ''CallStack)
# endif
#endif