{-# 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 = (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> Ptr a -> Builder
forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec Int -> a -> Builder
forall a. HasCallStack => a
undefined [a] -> Builder
forall a. HasCallStack => a
undefined
    {-# INLINE showbPrec #-}

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

#if !(MIN_VERSION_base(4,15,0))
        integerFromWord# :: Word# -> Integer
integerFromWord# = Word# -> Integer
wordToInteger
#endif

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

-- | /Since: 2/
instance TextShow1 FunPtr where
    liftShowbPrec :: (Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FunPtr a -> Builder
liftShowbPrec Int -> a -> Builder
_ [a] -> Builder
_ Int
_ = Ptr Any -> Builder
forall a. TextShow a => a -> Builder
showb (Ptr Any -> Builder)
-> (FunPtr a -> Ptr Any) -> FunPtr a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunPtr a -> Ptr Any
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 = Int -> Integer -> Builder
forall a. TextShow a => Int -> a -> Builder
showbPrec Int
p (IntPtr -> Integer
forall a b. a -> b
unsafeCoerce IntPtr
ip :: Integer)

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

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

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