module UI.HSCurses.CWString (
withUTF8String,
withUTF8StringLen,
newUTF8String,
newUTF8StringLen,
peekUTF8String,
peekUTF8StringLen,
withLCString,
withLCStringLen,
newLCString,
newLCStringLen,
peekLCStringLen,
peekLCString,
) where
import Data.Char ( ord, chr )
import Data.Bits ( Bits((.|.), (.&.), shift) )
import Foreign.C.String
withLCString :: String -> (Foreign.C.String.CString -> IO a) -> IO a
withLCString = withCString
withLCStringLen :: String -> (Foreign.C.String.CStringLen -> IO a) -> IO a
withLCStringLen = withCStringLen
newLCString :: String -> IO Foreign.C.String.CString
newLCString = newCString
newLCStringLen :: String -> IO Foreign.C.String.CStringLen
newLCStringLen = newCStringLen
peekLCString :: Foreign.C.String.CString -> IO String
peekLCString = peekCString
peekLCStringLen :: Foreign.C.String.CStringLen -> IO String
peekLCStringLen = peekCStringLen
withUTF8String :: String -> (CString -> IO a) -> IO a
withUTF8String hsStr = withCString (toUTF hsStr)
withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a
withUTF8StringLen hsStr = withCStringLen (toUTF hsStr)
newUTF8String :: String -> IO CString
newUTF8String = newCString . toUTF
newUTF8StringLen :: String -> IO CStringLen
newUTF8StringLen = newCStringLen . toUTF
peekUTF8String :: CString -> IO String
peekUTF8String strPtr = fmap fromUTF $ peekCString strPtr
peekUTF8StringLen :: CStringLen -> IO String
peekUTF8StringLen strPtr = fmap fromUTF $ peekCStringLen strPtr
toUTF :: String -> String
toUTF [] = []
toUTF (x:xs) | ord x<=0x007F = x:toUTF xs
| ord x<=0x07FF = chr (0xC0 .|. ((ord x `shift` (6)) .&. 0x1F)):
chr (0x80 .|. (ord x .&. 0x3F)):
toUTF xs
| otherwise = chr (0xE0 .|. ((ord x `shift` (12)) .&. 0x0F)):
chr (0x80 .|. ((ord x `shift` (6)) .&. 0x3F)):
chr (0x80 .|. (ord x .&. 0x3F)):
toUTF xs
fromUTF :: String -> String
fromUTF [] = []
fromUTF (al@(x:xs)) | ord x<=0x7F = x:fromUTF xs
| ord x<=0xBF = err
| ord x<=0xDF = twoBytes al
| ord x<=0xEF = threeBytes al
| otherwise = err
where
twoBytes (x1:x2:xs') = chr (((ord x1 .&. 0x1F) `shift` 6) .|.
(ord x2 .&. 0x3F)):fromUTF xs'
twoBytes _ = error "fromUTF: illegal two byte sequence"
threeBytes (x1:x2:x3:xs') = chr (((ord x1 .&. 0x0F) `shift` 12) .|.
((ord x2 .&. 0x3F) `shift` 6) .|.
(ord x3 .&. 0x3F)):fromUTF xs'
threeBytes _ = error "fromUTF: illegal three byte sequence"
err = error "fromUTF: illegal UTF-8 character"