{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE BlockArguments, TupleSections #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Data.Text.Foreign.MiscYj (

	-- * CONVERSION WITH CSTRING

	-- ** From CString

	cStringToText,

	-- ** To CString

	textToCString, textListToCStringArray

	) where

import Foreign.Ptr
import Foreign.Marshal
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Control.Monad.Cont.MiscYj

import qualified Data.Text as Txt
import qualified Data.Text.Foreign as Txt


textListToCStringArray :: [Txt.Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray :: forall a. [Text] -> (Ptr CString -> IO a) -> IO a
textListToCStringArray [Text]
txts Ptr CString -> IO a
f =
	(Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
textToCString (Text -> (CString -> IO a) -> IO a)
-> [Text] -> ([CString] -> IO a) -> IO a
forall a b (m :: * -> *) c.
(a -> (b -> m c) -> m c) -> [a] -> ([b] -> m c) -> m c
`mapContM` [Text]
txts) \[CString]
cstrl ->
	Int -> (Ptr CString -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
txts) \Ptr CString
pcstra ->
	Ptr CString -> [CString] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CString
pcstra [CString]
cstrl IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr CString -> IO a
f Ptr CString
pcstra

textToCString :: Txt.Text -> (CString -> IO a) -> IO a
textToCString :: forall a. Text -> (CString -> IO a) -> IO a
textToCString Text
t CString -> IO a
f = Text -> (CStringLen -> IO a) -> IO a
forall a. Text -> (CStringLen -> IO a) -> IO a
Txt.withCStringLen Text
t \(CString
cs, Int
ln) ->
	Int -> (CString -> IO a) -> IO a
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Int
ln Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) \CString
cs' -> do
		CString -> CString -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes CString
cs' CString
cs Int
ln
		CString -> CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (CString
cs' CString -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
ln :: Ptr CChar) CChar
0
		CString -> IO a
f CString
cs'

cStringToText :: CString -> IO Txt.Text
cStringToText :: CString -> IO Text
cStringToText CString
cs = CStringLen -> IO Text
Txt.peekCStringLen (CStringLen -> IO Text) -> IO CStringLen -> IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CString -> IO CStringLen
cstringToCStringLen CString
cs

cstringLength :: CString -> IO Int
cstringLength :: CString -> IO Int
cstringLength CString
pc = do
	CChar
c <- CString -> IO CChar
forall a. Storable a => Ptr a -> IO a
peek CString
pc
	case CChar
c of
		CChar
0 -> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
		CChar
_ -> (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> IO Int -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO Int
cstringLength (CString
pc CString -> Int -> CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)

cstringToCStringLen :: CString -> IO CStringLen
cstringToCStringLen :: CString -> IO CStringLen
cstringToCStringLen CString
cs = (CString
cs ,) (Int -> CStringLen) -> IO Int -> IO CStringLen
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO Int
cstringLength CString
cs