module System.Glib.UTFString (
withUTFString,
withUTFStringLen,
newUTFString,
newUTFStringLen,
peekUTFString,
peekUTFStringLen,
maybePeekUTFString,
readUTFString,
readCString,
withUTFStrings,
withUTFStringArray,
withUTFStringArray0,
peekUTFStringArray,
peekUTFStringArray0,
readUTFStringArray0,
UTFCorrection,
genUTFOfs,
ofsToUTF,
ofsFromUTF
) where
import Codec.Binary.UTF8.String
import Control.Monad (liftM)
import Data.Char (ord, chr)
import Data.Maybe (maybe)
import System.Glib.FFI
withUTFString :: String -> (CString -> IO a) -> IO a
withUTFString = withCAString . encodeString
withUTFStringLen :: String -> (CStringLen -> IO a) -> IO a
withUTFStringLen = withCAStringLen . encodeString
newUTFString :: String -> IO CString
newUTFString = newCAString . encodeString
newUTFStringLen :: String -> IO CStringLen
newUTFStringLen = newCAStringLen . encodeString
peekUTFString :: CString -> IO String
peekUTFString = liftM decodeString . peekCAString
maybePeekUTFString :: CString -> IO (Maybe String)
maybePeekUTFString = liftM (maybe Nothing (Just . decodeString)) . maybePeek peekCAString
peekUTFStringLen :: CStringLen -> IO String
peekUTFStringLen = liftM decodeString . peekCAStringLen
readUTFString :: CString -> IO String
readUTFString strPtr = do
str <- peekUTFString strPtr
g_free strPtr
return str
readCString :: CString -> IO String
readCString strPtr = do
str <- peekCAString strPtr
g_free strPtr
return str
foreign import ccall unsafe "g_free"
g_free :: Ptr a -> IO ()
withUTFStrings :: [String] -> ([CString] -> IO a) -> IO a
withUTFStrings hsStrs = withUTFStrings' hsStrs []
where withUTFStrings' :: [String] -> [CString] -> ([CString] -> IO a) -> IO a
withUTFStrings' [] cs body = body (reverse cs)
withUTFStrings' (s:ss) cs body = withUTFString s $ \c ->
withUTFStrings' ss (c:cs) body
withUTFStringArray :: [String] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray hsStr body =
withUTFStrings hsStr $ \cStrs -> do
withArray cStrs body
withUTFStringArray0 :: [String] -> (Ptr CString -> IO a) -> IO a
withUTFStringArray0 hsStr body =
withUTFStrings hsStr $ \cStrs -> do
withArray0 nullPtr cStrs body
peekUTFStringArray :: Int -> Ptr CString -> IO [String]
peekUTFStringArray len cStrArr = do
cStrs <- peekArray len cStrArr
mapM peekUTFString cStrs
peekUTFStringArray0 :: Ptr CString -> IO [String]
peekUTFStringArray0 cStrArr = do
cStrs <- peekArray0 nullPtr cStrArr
mapM peekUTFString cStrs
readUTFStringArray0 :: Ptr CString -> IO [String]
readUTFStringArray0 cStrArr | cStrArr == nullPtr = return []
| otherwise = do
cStrs <- peekArray0 nullPtr cStrArr
strings <- mapM peekUTFString cStrs
g_strfreev cStrArr
return strings
foreign import ccall unsafe "g_strfreev"
g_strfreev :: Ptr a -> IO ()
newtype UTFCorrection = UTFCorrection [Int] deriving Show
genUTFOfs :: String -> UTFCorrection
genUTFOfs str = UTFCorrection (gUO 0 str)
where
gUO n [] = []
gUO n (x:xs) | ord x<=0x007F = gUO (n+1) xs
| ord x<=0x07FF = n:gUO (n+1) xs
| ord x<=0xFFFF = n:n:gUO (n+1) xs
| otherwise = n:n:n:gUO (n+1) xs
ofsToUTF :: Int -> UTFCorrection -> Int
ofsToUTF n (UTFCorrection oc) = oTU oc
where
oTU [] = n
oTU (x:xs) | n<=x = n
| otherwise = 1+oTU xs
ofsFromUTF :: Int -> UTFCorrection -> Int
ofsFromUTF n (UTFCorrection oc) = oFU n oc
where
oFU n [] = n
oFU n (x:xs) | n<=x = n
| otherwise = oFU (n1) xs