{-# LANGUAGE
  MultiParamTypeClasses,
  UndecidableInstances
  #-}
module LLVM.Internal.String where

import LLVM.Prelude

import Control.Arrow
import Control.Monad.AnyCont
import Control.Monad.IO.Class
import Control.Exception (finally)
import Foreign.C (CString, CChar)
import Foreign.Ptr
import Foreign.Storable (Storable)
import Foreign.Marshal.Alloc as F.M (alloca, free)

import LLVM.Internal.FFI.LLVMCTypes

import LLVM.Internal.Coding

import qualified Data.ByteString as BS
import qualified LLVM.Internal.FFI.ShortByteString as SBS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.UTF8 as BSUTF8

newtype UTF8ByteString = UTF8ByteString { UTF8ByteString -> ByteString
utf8Bytes :: BS.ByteString }

instance (Monad e) => EncodeM e String UTF8ByteString where
  encodeM :: String -> e UTF8ByteString
encodeM = UTF8ByteString -> e UTF8ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (UTF8ByteString -> e UTF8ByteString)
-> (String -> UTF8ByteString) -> String -> e UTF8ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UTF8ByteString
UTF8ByteString (ByteString -> UTF8ByteString)
-> (String -> ByteString) -> String -> UTF8ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSUTF8.fromString

instance (Monad d) => DecodeM d String UTF8ByteString where
  decodeM :: UTF8ByteString -> d String
decodeM = String -> d String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> d String)
-> (UTF8ByteString -> String) -> UTF8ByteString -> d String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSUTF8.toString (ByteString -> String)
-> (UTF8ByteString -> ByteString) -> UTF8ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF8ByteString -> ByteString
utf8Bytes

instance (MonadAnyCont IO e) => EncodeM e String CString where
  encodeM :: String -> e CString
encodeM s :: String
s = (forall r. (CString -> IO r) -> IO r) -> e CString
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (ByteString -> (CString -> IO r) -> IO r
forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCString (ByteString -> (CString -> IO r) -> IO r)
-> (UTF8ByteString -> ByteString)
-> UTF8ByteString
-> (CString -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF8ByteString -> ByteString
utf8Bytes (UTF8ByteString -> (CString -> IO r) -> IO r)
-> ((CString -> IO r) -> UTF8ByteString)
-> (CString -> IO r)
-> IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> (CString -> IO r) -> UTF8ByteString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\0"))

instance (MonadAnyCont IO e) => EncodeM e ByteString CString where
  encodeM :: ByteString -> e CString
encodeM s :: ByteString
s = (forall r. (CString -> IO r) -> IO r) -> e CString
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (ByteString -> (CString -> IO r) -> IO r
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
s)

instance (MonadAnyCont IO e) => EncodeM e ShortByteString CString where
  encodeM :: ShortByteString -> e CString
encodeM s :: ShortByteString
s = (forall r. (CString -> IO r) -> IO r) -> e CString
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (ShortByteString -> (CString -> IO r) -> IO r
forall a. ShortByteString -> (CString -> IO a) -> IO a
SBS.useAsCString ShortByteString
s)

instance (Integral i, MonadAnyCont IO e) => EncodeM e String (Ptr CChar, i) where
  encodeM :: String -> e (CString, i)
encodeM s :: String
s = (forall r. ((CString, i) -> IO r) -> IO r) -> e (CString, i)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (((((CString, Int) -> IO r) -> IO r)
-> (((CString, i) -> IO r) -> (CString, Int) -> IO r)
-> ((CString, i) -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((CString, i) -> IO r)
-> ((CString, Int) -> (CString, i)) -> (CString, Int) -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> i) -> (CString, Int) -> (CString, i)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral)) ((((CString, Int) -> IO r) -> IO r)
 -> ((CString, i) -> IO r) -> IO r)
-> (((CString, Int) -> IO r) -> IO r)
-> ((CString, i) -> IO r)
-> IO r
forall a b. (a -> b) -> a -> b
$ ByteString -> ((CString, Int) -> IO r) -> IO r
forall a. ByteString -> ((CString, Int) -> IO a) -> IO a
BS.useAsCStringLen (ByteString -> ((CString, Int) -> IO r) -> IO r)
-> (UTF8ByteString -> ByteString)
-> UTF8ByteString
-> ((CString, Int) -> IO r)
-> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTF8ByteString -> ByteString
utf8Bytes (UTF8ByteString -> ((CString, Int) -> IO r) -> IO r)
-> (((CString, Int) -> IO r) -> UTF8ByteString)
-> ((CString, Int) -> IO r)
-> IO r
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> ((CString, Int) -> IO r) -> UTF8ByteString
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM String
s)

instance (Integral i, MonadAnyCont IO e) => EncodeM e ByteString (Ptr CChar, i) where
  encodeM :: ByteString -> e (CString, i)
encodeM s :: ByteString
s =
    (forall r. ((CString, i) -> IO r) -> IO r) -> e (CString, i)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (\cont :: (CString, i) -> IO r
cont -> ByteString -> ((CString, Int) -> IO r) -> IO r
forall a. ByteString -> ((CString, Int) -> IO a) -> IO a
BS.useAsCStringLen ByteString
s (\(ptr :: CString
ptr, len :: Int
len) -> (CString, i) -> IO r
cont (CString
ptr, Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)))

instance (Integral i, MonadAnyCont IO e) => EncodeM e ShortByteString (Ptr CChar, i) where
  encodeM :: ShortByteString -> e (CString, i)
encodeM s :: ShortByteString
s =
    (forall r. ((CString, i) -> IO r) -> IO r) -> e (CString, i)
forall (b :: * -> *) (m :: * -> *) a.
MonadAnyCont b m =>
(forall r. (a -> b r) -> b r) -> m a
anyContToM (\cont :: (CString, i) -> IO r
cont -> ShortByteString -> ((CString, Int) -> IO r) -> IO r
forall a. ShortByteString -> ((CString, Int) -> IO a) -> IO a
SBS.useAsCStringLen ShortByteString
s (\(ptr :: CString
ptr, len :: Int
len) -> (CString, i) -> IO r
cont (CString
ptr, Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)))

instance (MonadIO d) => DecodeM d String CString where
  decodeM :: CString -> d String
decodeM = UTF8ByteString -> d String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (UTF8ByteString -> d String)
-> (ByteString -> UTF8ByteString) -> ByteString -> d String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UTF8ByteString
UTF8ByteString (ByteString -> d String)
-> (CString -> d ByteString) -> CString -> d String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO ByteString -> d ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> d ByteString)
-> (CString -> IO ByteString) -> CString -> d ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
BS.packCString

instance (MonadIO d) => DecodeM d ByteString CString where
  decodeM :: CString -> d ByteString
decodeM = IO ByteString -> d ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> d ByteString)
-> (CString -> IO ByteString) -> CString -> d ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
BS.packCString

instance (MonadIO d) => DecodeM d ShortByteString CString where
  decodeM :: CString -> d ShortByteString
decodeM = IO ShortByteString -> d ShortByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> d ShortByteString)
-> (CString -> IO ShortByteString) -> CString -> d ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ShortByteString
SBS.packCString

instance (MonadIO d) => DecodeM d String (OwnerTransfered CString) where
  decodeM :: OwnerTransfered CString -> d String
decodeM (OwnerTransfered s :: CString
s) = IO String -> d String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> d String) -> IO String -> d String
forall a b. (a -> b) -> a -> b
$ IO String -> IO () -> IO String
forall a b. IO a -> IO b -> IO a
finally (CString -> IO String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM CString
s) (CString -> IO ()
forall a. Ptr a -> IO ()
free CString
s)

instance (MonadIO d) => DecodeM d ByteString (OwnerTransfered CString) where
  decodeM :: OwnerTransfered CString -> d ByteString
decodeM (OwnerTransfered s :: CString
s) = IO ByteString -> d ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> d ByteString) -> IO ByteString -> d ByteString
forall a b. (a -> b) -> a -> b
$ IO ByteString -> IO () -> IO ByteString
forall a b. IO a -> IO b -> IO a
finally (CString -> IO ByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM CString
s) (CString -> IO ()
forall a. Ptr a -> IO ()
free CString
s)

instance (MonadIO d) => DecodeM d ShortByteString (OwnerTransfered CString) where
  decodeM :: OwnerTransfered CString -> d ShortByteString
decodeM (OwnerTransfered s :: CString
s) = IO ShortByteString -> d ShortByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> d ShortByteString)
-> IO ShortByteString -> d ShortByteString
forall a b. (a -> b) -> a -> b
$ IO ShortByteString -> IO () -> IO ShortByteString
forall a b. IO a -> IO b -> IO a
finally (CString -> IO ShortByteString
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM CString
s) (CString -> IO ()
forall a. Ptr a -> IO ()
free CString
s)
instance (MonadIO d, DecodeM IO s (OwnerTransfered CString)) =>DecodeM d s (Ptr (OwnerTransfered CString)) where
  decodeM :: Ptr (OwnerTransfered CString) -> d s
decodeM = IO s -> d s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> d s)
-> (OwnerTransfered CString -> IO s)
-> OwnerTransfered CString
-> d s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OwnerTransfered CString -> IO s
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (OwnerTransfered CString -> d s)
-> (Ptr (OwnerTransfered CString) -> d (OwnerTransfered CString))
-> Ptr (OwnerTransfered CString)
-> d s
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ptr (OwnerTransfered CString) -> d (OwnerTransfered CString)
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek

instance (Integral i, MonadIO d) => DecodeM d String (Ptr CChar, i) where
  decodeM :: (CString, i) -> d String
decodeM = UTF8ByteString -> d String
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM (UTF8ByteString -> d String)
-> (ByteString -> UTF8ByteString) -> ByteString -> d String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> UTF8ByteString
UTF8ByteString (ByteString -> d String)
-> ((CString, i) -> d ByteString) -> (CString, i) -> d String
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO ByteString -> d ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> d ByteString)
-> ((CString, i) -> IO ByteString) -> (CString, i) -> d ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> IO ByteString
BS.packCStringLen ((CString, Int) -> IO ByteString)
-> ((CString, i) -> (CString, Int))
-> (CString, i)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Int) -> (CString, i) -> (CString, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance (Integral i, MonadIO d) => DecodeM d BS.ByteString (Ptr CChar, i) where
  decodeM :: (CString, i) -> d ByteString
decodeM = IO ByteString -> d ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> d ByteString)
-> ((CString, i) -> IO ByteString) -> (CString, i) -> d ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> IO ByteString
BS.packCStringLen ((CString, Int) -> IO ByteString)
-> ((CString, i) -> (CString, Int))
-> (CString, i)
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Int) -> (CString, i) -> (CString, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance (Integral i, MonadIO d) => DecodeM d ShortByteString (Ptr CChar, i) where
  decodeM :: (CString, i) -> d ShortByteString
decodeM = IO ShortByteString -> d ShortByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ShortByteString -> d ShortByteString)
-> ((CString, i) -> IO ShortByteString)
-> (CString, i)
-> d ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CString, Int) -> IO ShortByteString
SBS.packCStringLen ((CString, Int) -> IO ShortByteString)
-> ((CString, i) -> (CString, Int))
-> (CString, i)
-> IO ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Int) -> (CString, i) -> (CString, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance (Integral i, Storable i, MonadIO d, DecodeM d s (CString, i)) => DecodeM d s (Ptr i -> IO CString) where
  decodeM :: (Ptr i -> IO CString) -> d s
decodeM f :: Ptr i -> IO CString
f = (CString, i) -> d s
forall (d :: * -> *) h c. DecodeM d h c => c -> d h
decodeM ((CString, i) -> d s) -> d (CString, i) -> d s
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (CString, i) -> d (CString, i)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CString, i) -> d (CString, i))
-> IO (CString, i) -> d (CString, i)
forall a b. (a -> b) -> a -> b
$ (Ptr i -> IO (CString, i)) -> IO (CString, i)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.M.alloca ((Ptr i -> IO (CString, i)) -> IO (CString, i))
-> (Ptr i -> IO (CString, i)) -> IO (CString, i)
forall a b. (a -> b) -> a -> b
$ \p :: Ptr i
p -> (,) (CString -> i -> (CString, i))
-> IO CString -> IO (i -> (CString, i))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr i -> IO CString
f Ptr i
p IO (i -> (CString, i)) -> IO i -> IO (CString, i)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` Ptr i -> IO i
forall a (m :: * -> *). (Storable a, MonadIO m) => Ptr a -> m a
peek Ptr i
p)

instance (Monad e, EncodeM e String c) => EncodeM e (Maybe String) (NothingAsEmptyString c) where
  encodeM :: Maybe String -> e (NothingAsEmptyString c)
encodeM = (c -> NothingAsEmptyString c) -> e c -> e (NothingAsEmptyString c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM c -> NothingAsEmptyString c
forall c. c -> NothingAsEmptyString c
NothingAsEmptyString (e c -> e (NothingAsEmptyString c))
-> (Maybe String -> e c)
-> Maybe String
-> e (NothingAsEmptyString c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> e c
forall (e :: * -> *) h c. EncodeM e h c => h -> e c
encodeM (String -> e c) -> (Maybe String -> String) -> Maybe String -> e c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe ""