{-# 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 ""