{-# LANGUAGE CPP       #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Foreign.Ptr
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances for pointer types used in the Haskell
Foreign Function Interface (FFI).

/Since: 2/
-}
module TextShow.Foreign.Ptr () where

import Data.Semigroup.Compat (mtimesDefault)
import Data.Text.Lazy.Builder (Builder, singleton)

import Foreign.ForeignPtr (ForeignPtr)
import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr)

import GHC.Exts (addr2Int#, int2Word#)
import GHC.ForeignPtr (unsafeForeignPtrToPtr)
import GHC.Num
import GHC.Ptr (Ptr(..))

import Prelude ()
import Prelude.Compat

import TextShow.Classes (TextShow(..), TextShow1(..))
import TextShow.Data.Integral (showbHex)
import TextShow.Utils (lengthB)

import Unsafe.Coerce (unsafeCoerce)

#include "MachDeps.h"

-- | /Since: 2/
instance TextShow (Ptr a) where
    showbPrec :: Int -> Ptr a -> Builder
showbPrec = forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 Ptr where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Ptr a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ Int
_ (Ptr Addr#
a) = Builder -> Builder
padOut forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, TextShow a) => a -> Builder
showbHex forall a b. (a -> b) -> a -> b
$
      Word# -> Integer
integerFromWord# (Int# -> Word#
int2Word# (Addr# -> Int#
addr2Int# Addr#
a))
      where
        padOut :: Builder -> Builder
        padOut :: Builder -> Builder
padOut Builder
ls =
             Char -> Builder
singleton Char
'0' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'x'
          forall a. Semigroup a => a -> a -> a
<> forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault (forall a. Ord a => a -> a -> a
max Int64
0 forall a b. (a -> b) -> a -> b
$ Int64
2forall a. Num a => a -> a -> a
*SIZEOF_HSPTR - lengthB ls) (singleton '0')
          forall a. Semigroup a => a -> a -> a
<> Builder
ls

#if !(MIN_VERSION_base(4,15,0))
        integerFromWord# = wordToInteger
#endif

-- | /Since: 2/
instance TextShow (FunPtr a) where
    showbPrec :: Int -> FunPtr a -> Builder
showbPrec = forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 FunPtr where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FunPtr a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ Int
_ = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. FunPtr a -> Ptr b
castFunPtrToPtr
    {-# INLINE liftShowbPrec #-}

-- | /Since: 2/
instance TextShow IntPtr where
    showbPrec :: Int -> IntPtr -> Builder
showbPrec Int
p IntPtr
ip = forall a. TextShow a => Int -> a -> Builder
showbPrec Int
p (forall a b. a -> b
unsafeCoerce IntPtr
ip :: Integer)

-- | /Since: 2/
instance TextShow WordPtr where
    showb :: WordPtr -> Builder
showb WordPtr
wp = forall a. TextShow a => a -> Builder
showb (forall a b. a -> b
unsafeCoerce WordPtr
wp :: Word)

-- | /Since: 2/
instance TextShow (ForeignPtr a) where
    showbPrec :: Int -> ForeignPtr a -> Builder
showbPrec = forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec forall a. HasCallStack => a
undefined forall a. HasCallStack => a
undefined
    {-# INLINE showbPrec #-}

-- | /Since: 2/
instance TextShow1 ForeignPtr where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> ForeignPtr a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ Int
_ = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr
    {-# INLINE liftShowbPrec #-}