{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module:      TextShow.Trace.Hpc
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances for data types in the @hpc@ library.

/Since: 2/
-}
module TextShow.Trace.Hpc () where

import Prelude ()
import Prelude.Compat

import TextShow (TextShow(..), FromStringShow(..), singleton)
import TextShow.Data.Time ()
import TextShow.TH (deriveTextShow)

import Trace.Hpc.Mix (Mix, BoxLabel, CondBox)
import Trace.Hpc.Tix (Tix, TixModule)
import Trace.Hpc.Util (HpcPos, Hash, fromHpcPos)

-- | /Since: 2/
instance TextShow HpcPos where
    showb :: HpcPos -> Builder
showb HpcPos
hp = case HpcPos -> (Int, Int, Int, Int)
fromHpcPos HpcPos
hp of
        (Int
l1, Int
c1, Int
l2, Int
c2) -> forall a. TextShow a => a -> Builder
showb Int
l1
               forall a. Semigroup a => a -> a -> a
<> (Char -> Builder
singleton Char
':' forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb Int
c1)
               forall a. Semigroup a => a -> a -> a
<> (Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb Int
l2)
               forall a. Semigroup a => a -> a -> a
<> (Char -> Builder
singleton Char
':' forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb Int
c2)
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow Hash where
    showb :: Hash -> Builder
showb = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromStringShow a
FromStringShow
    {-# INLINE showb #-}

-- | /Since: 2/
$(deriveTextShow ''TixModule)
-- | /Since: 2/
$(deriveTextShow ''CondBox)
-- | /Since: 2/
$(deriveTextShow ''BoxLabel)
-- | /Since: 2/
$(deriveTextShow ''Mix)
-- | /Since: 2/
$(deriveTextShow ''Tix)