bindings-common-0.2.2: example/test.hsc

#include <bindings.macros.h>
#include "example.h"

#bindings_initialize

module Main (main) where
import Foreign
import Foreign.C
import Data.Int
import Data.List
import Control.Monad
import System.IO.Unsafe

#bindings_num UNICODE_2_UTF8
#bindings_num UTF8_2_UNICODE

#bindings_starttype struct unicode_translator
#bindings_field unicode , Word32
#bindings_array_field eight_bits , Word8 , 4
#bindings_field nchars , CInt
#bindings_stoptype

#bindings_function translate , CInt -> Ptr Unicode_translator -> IO ()

toChar :: (Enum a, Enum b) => a -> b
toChar = toEnum . fromEnum
fromChar :: (Enum a, Num b) => a -> b
fromChar = fromIntegral . fromEnum

unicodeToUtf :: String -> IO String
unicodeToUtf string = liftM concat $ alloca $ \ptrUt ->
  (flip mapM) string $ \char -> do
      ut <- peek ptrUt
      poke ptrUt (ut {unicode_translator'unicode = toChar char})
      translate _UNICODE_2_UTF8 ptrUt
      ut <- peek ptrUt
      let nChars = fromIntegral $ unicode_translator'nchars ut
      let eightBits = unicode_translator'eight_bits ut
      return $ (map toChar) $ reverse $ take nChars eightBits

utfToUnicode :: String -> IO String
utfToUnicode =
 (. (map fromChar)) $
 (. splitCodes) $
 mapM $ \c -> do
    let ut = Unicode_translator {
               unicode_translator'nchars = fromIntegral $ length c,
               unicode_translator'eight_bits = reverse $ map fromChar c,
               unicode_translator'unicode = 0
              }
    unicode <- with ut $ \ptr -> do
        translate _UTF8_2_UNICODE ptr
        liftM unicode_translator'unicode $ peek ptr
    return $ toChar $ unicode
 where
     splitCodes :: [Word8] -> [[Word8]]
     splitCodes [] = []
     splitCodes (a:t) = if (a < 0x80)
       then
         [a]:(splitCodes t)
       else
         let i = findIndex (\c -> c < 0x80 || c > 0xBF) t
             (t1,t2) = maybe ([],t) (flip splitAt t) i
         in (a:t1):(splitCodes t2)

toUtf8 :: String -> String
toUtf8 = unsafePerformIO . unicodeToUtf

fromUtf8 :: String -> String
fromUtf8 = unsafePerformIO . utfToUnicode

printAsInt :: String -> IO ()
printAsInt s = putStrLn $ show $ map fromEnum s

main = do
 let a = "Exceção"
 printAsInt a
 printAsInt $ toUtf8 a
 printAsInt $ fromUtf8 $ toUtf8 a