{-# LANGUAGE CPP #-}
{-# LANGUAGE RoleAnnotations #-}
module Foreign.SharedObjectName.Internal
( SOName (..), hPutSOName, hGetSOName, unsafeWithSOName
, genSOName, newEmptySOName
) where
import Foreign.C.String
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.ForeignPtr.Unsafe
import Foreign.Ptr
import Foreign.Storable
import System.IO
import System.IO.Unsafe
import Text.Read
#define HS_IMPORT_CONSTANTS_ONLY
#include "MachDeps.h"
#include "common.h"
newtype SOName a = SOName (ForeignPtr CChar)
type role SOName phantom
instance Show (SOName a) where
showsPrec :: Int -> SOName a -> ShowS
showsPrec Int
d (SOName ForeignPtr CChar
a)
= Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"SOName " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 String
getstr
where
getstr :: String
getstr = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> (Ptr CChar -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
a Ptr CChar -> IO String
peekCAString
{-# NOINLINE getstr #-}
instance Read (SOName a) where
readPrec :: ReadPrec (SOName a)
readPrec = ReadPrec (SOName a) -> ReadPrec (SOName a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (SOName a) -> ReadPrec (SOName a))
-> ReadPrec (SOName a) -> ReadPrec (SOName a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (SOName a) -> ReadPrec (SOName a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (SOName a) -> ReadPrec (SOName a))
-> ReadPrec (SOName a) -> ReadPrec (SOName a)
forall a b. (a -> b) -> a -> b
$ do
Ident String
"SOName" <- ReadPrec Lexeme
lexP
String
s <- ReadPrec String -> ReadPrec String
forall a. ReadPrec a -> ReadPrec a
step ReadPrec String
forall a. Read a => ReadPrec a
readPrec
SOName a -> ReadPrec (SOName a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SOName a -> ReadPrec (SOName a))
-> SOName a -> ReadPrec (SOName a)
forall a b. (a -> b) -> a -> b
$ String -> SOName a
forall a. String -> SOName a
putstr String
s
where
writeStr :: String -> Int -> Ptr CChar -> IO ()
writeStr [] Int
n Ptr CChar
ptr
= Ptr CChar -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
ptr Int
n CChar
0
writeStr (Char
c:String
cs) Int
n Ptr CChar
ptr
= Ptr CChar -> Int -> CChar -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CChar
ptr Int
n (Char -> CChar
castCharToCChar Char
c) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Int -> Ptr CChar -> IO ()
writeStr String
cs (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr CChar
ptr
putstr :: String -> SOName a
putstr String
s = IO (SOName a) -> SOName a
forall a. IO a -> a
unsafePerformIO (IO (SOName a) -> SOName a) -> IO (SOName a) -> SOName a
forall a b. (a -> b) -> a -> b
$ do
SOName a
n <- IO (SOName a)
forall a. IO (SOName a)
newEmptySOName
SOName a -> (Ptr CChar -> IO ()) -> IO ()
forall a b. SOName a -> (Ptr CChar -> IO b) -> IO b
unsafeWithSOName SOName a
n ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> Ptr CChar -> IO ()
writeStr String
s Int
0
SOName a -> IO (SOName a)
forall (m :: * -> *) a. Monad m => a -> m a
return SOName a
n
{-# NOINLINE putstr #-}
instance Eq (SOName a) where
(SOName ForeignPtr CChar
a) == :: SOName a -> SOName a -> Bool
== (SOName ForeignPtr CChar
b)
= Ptr CChar -> Ptr CChar -> Ordering
cmpCStrings (ForeignPtr CChar -> Ptr CChar
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CChar
a) (ForeignPtr CChar -> Ptr CChar
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CChar
b) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord (SOName a) where
compare :: SOName a -> SOName a -> Ordering
compare (SOName ForeignPtr CChar
a) (SOName ForeignPtr CChar
b)
= Ptr CChar -> Ptr CChar -> Ordering
cmpCStrings (ForeignPtr CChar -> Ptr CChar
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CChar
a) (ForeignPtr CChar -> Ptr CChar
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr CChar
b)
instance Storable (SOName a) where
sizeOf :: SOName a -> Int
sizeOf SOName a
_ = SHARED_OBJECT_NAME_LENGTH
alignment :: SOName a -> Int
alignment SOName a
_ = SIZEOF_HSWORD
poke :: Ptr (SOName a) -> SOName a -> IO ()
poke Ptr (SOName a)
p (SOName ForeignPtr CChar
qp) = ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
qp
((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
q -> Ptr (SOName a) -> Ptr CChar -> CInt -> IO ()
forall a b. Ptr a -> Ptr b -> CInt -> IO ()
c_memcpy Ptr (SOName a)
p Ptr CChar
q SHARED_OBJECT_NAME_LENGTH
peek :: Ptr (SOName a) -> IO (SOName a)
peek Ptr (SOName a)
p = do
ForeignPtr CChar
qp <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes SHARED_OBJECT_NAME_LENGTH
ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
qp
((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
q -> Ptr CChar -> Ptr (SOName a) -> CInt -> IO ()
forall a b. Ptr a -> Ptr b -> CInt -> IO ()
c_memcpy Ptr CChar
q Ptr (SOName a)
p SHARED_OBJECT_NAME_LENGTH
SOName a -> IO (SOName a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SOName a -> IO (SOName a)) -> SOName a -> IO (SOName a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> SOName a
forall a. ForeignPtr CChar -> SOName a
SOName ForeignPtr CChar
qp
hPutSOName :: Handle -> SOName a -> IO ()
hPutSOName :: Handle -> SOName a -> IO ()
hPutSOName Handle
h (SOName ForeignPtr CChar
q)
= ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
q ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ (Ptr CChar -> Int -> IO ()) -> Int -> Ptr CChar -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Handle -> Ptr CChar -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h) SHARED_OBJECT_NAME_LENGTH
hGetSOName :: Handle -> IO (Maybe (SOName a))
hGetSOName :: Handle -> IO (Maybe (SOName a))
hGetSOName Handle
h = do
let n :: Int
n = SHARED_OBJECT_NAME_LENGTH
ForeignPtr CChar
q <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
n
Int
n' <- ForeignPtr CChar -> (Ptr CChar -> IO Int) -> IO Int
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
q ((Ptr CChar -> IO Int) -> IO Int)
-> (Ptr CChar -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
p -> Handle -> Ptr CChar -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr CChar
p Int
n
Maybe (SOName a) -> IO (Maybe (SOName a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SOName a) -> IO (Maybe (SOName a)))
-> Maybe (SOName a) -> IO (Maybe (SOName a))
forall a b. (a -> b) -> a -> b
$
if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
then Maybe (SOName a)
forall a. Maybe a
Nothing
else SOName a -> Maybe (SOName a)
forall a. a -> Maybe a
Just (ForeignPtr CChar -> SOName a
forall a. ForeignPtr CChar -> SOName a
SOName ForeignPtr CChar
q)
genSOName :: IO (SOName a)
genSOName :: IO (SOName a)
genSOName = do
ForeignPtr CChar
fp <- Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes SHARED_OBJECT_NAME_LENGTH
ForeignPtr CChar -> (Ptr CChar -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fp Ptr CChar -> IO ()
c_genSharedObjectName
SOName a -> IO (SOName a)
forall (m :: * -> *) a. Monad m => a -> m a
return (SOName a -> IO (SOName a)) -> SOName a -> IO (SOName a)
forall a b. (a -> b) -> a -> b
$ ForeignPtr CChar -> SOName a
forall a. ForeignPtr CChar -> SOName a
SOName ForeignPtr CChar
fp
newEmptySOName :: IO (SOName a)
newEmptySOName :: IO (SOName a)
newEmptySOName = ForeignPtr CChar -> SOName a
forall a. ForeignPtr CChar -> SOName a
SOName (ForeignPtr CChar -> SOName a)
-> IO (ForeignPtr CChar) -> IO (SOName a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (ForeignPtr CChar)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes SHARED_OBJECT_NAME_LENGTH
unsafeWithSOName :: SOName a -> (CString -> IO b) -> IO b
unsafeWithSOName :: SOName a -> (Ptr CChar -> IO b) -> IO b
unsafeWithSOName (SOName ForeignPtr CChar
fp) = ForeignPtr CChar -> (Ptr CChar -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CChar
fp
cmpCStrings :: CString -> CString -> Ordering
cmpCStrings :: Ptr CChar -> Ptr CChar -> Ordering
cmpCStrings Ptr CChar
a Ptr CChar
b
| Ptr CChar
a Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
b = Ordering
EQ
| Bool
otherwise = Ptr CChar -> Ptr CChar -> CInt
c_strcmp Ptr CChar
a Ptr CChar
b CInt -> CInt -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CInt
0
foreign import ccall unsafe "strcmp"
c_strcmp :: CString -> CString -> CInt
foreign import ccall unsafe "memcpy"
c_memcpy :: Ptr a -> Ptr b -> CInt -> IO ()
foreign import ccall unsafe "genSharedObjectName"
c_genSharedObjectName :: CString -> IO ()