{-# OPTIONS -fffi -fglasgow-exts #-}
module IConv(stringToCWchars,cwcharsToString,bytesToString,stringToBytes,withIConv,convertRaw,setupLocale,getCharset) where

import Foreign
import Foreign.C.String
import Foreign.C.Types
import Foreign.C.Error
import Control.Exception
import GHC.Exts -- Just for Addr

import CWStringBasic

#include <iconv.h>
#include <errno.h>
#include <inttypes.h>
#include <locale.h>
#include <langinfo.h>

stringToCWchars :: String -> IO [CWchar]
stringToCWchars cs = (withIConv "WCHAR_T" "UTF-32" $ \ic -> convertRaw ic cs) 

cwcharsToString :: [CWchar] -> IO String
cwcharsToString xs =  (withIConv "UTF-32" "WCHAR_T" $ \ic ->  convertRaw ic xs) >>= return . f where
    f ('\65279':xs) = xs   -- discard byte order marker
    f xs = xs

stringToBytes :: String -> IO [Word8]
stringToBytes cs = (withIConv "" "UTF-32" $ \ic -> convertRaw ic cs) 

bytesToString :: [Word8] -> IO String
bytesToString xs =  (withIConv "UTF-32" "" $ \ic ->  convertRaw ic xs) >>= return . f where
    f ('\65279':xs) = xs   -- discard byte order marker
    f xs = xs

-- Should we cache the iconv_t?
isRepresentable :: String -> Char -> IO Bool
isRepresentable charset ch = handle (\_ -> return False) ((withIConv "" "UTF-32" $ \ic -> (convertRaw ic [ch] :: IO [Word8])) >> return True)

newtype IConv = IConv (#type intptr_t)
    deriving(Num,Eq,Show)


withIConv :: String -> String -> (IConv -> IO a) -> IO a 
withIConv to from action = bracket open close action where
    close ic = throwErrnoIfMinus1_ "iconv_close" (iconv_close ic)
    open = throwErrnoIfMinus1 "iconv_open" iopen
    iopen = do
        withCAString to $ \to -> do
        withCAString from $ \from -> do
        iconv_open to from


convertRaw :: (Storable a, Storable b) => IConv -> [a] -> IO [b]
convertRaw ic xs = do 
    with (fromIntegral $ sizeOf (head xs) * length xs) $ \inptrSz -> do
    withArray xs $ \arr -> do  
    with (castPtr arr) $ \inptr -> do
    allocaBytes (1024) $ \outptr -> do
    with outptr $ \outptrptr -> do
    with 1024 $ \outptrSz -> do
    let outSz = fromIntegral $ sizeOf $ unsafePerformIO (peek outptr) 
    let 
        go = do 
            ret <- iconv ic inptr inptrSz (castPtr outptrptr) outptrSz 
            err <- getErrno
            case (ret,err) of
                (-1,_) | err == e2BIG -> do
                    oz <- peek outptrSz
                    x <- peekArray ((1024 - fromIntegral oz) `div` outSz) (castPtr outptr) 
                    poke outptrptr outptr
                    poke outptrSz 1024
                    y <- go
                    return $ x ++ y
                (-1,_) -> throwErrno "iconv"
                (_,_) -> do
                    oz <- peek outptrSz
                    peekArray ((1024 - fromIntegral oz) `div` outSz) outptr 
    go
                
            
    


{-
convertFromString :: IConv -> String -> IO [Word8]
convertFromString ic s = do
    alloca $ \inptr -> do
    withArray s $ \arr -> do  
    poke inptr (castPtr arr)

convertToString :: IConv -> [Word8] -> IO String 
-}

setupLocale :: IO ()
setupLocale = setlocale (#const LC_ALL) ""## >> return () 

getCharset :: IO String
getCharset =  nl_langinfo (#const CODESET) >>= peekCString   


foreign import ccall unsafe "locale.h setlocale" setlocale :: CInt -> Addr## -> IO (Ptr CChar)
foreign import ccall unsafe "langinfo.h nl_langinfo" nl_langinfo :: (#type nl_item) -> IO (Ptr CChar)
foreign import ccall iconv_open :: Ptr CChar -> Ptr CChar -> IO IConv
foreign import ccall iconv_close :: IConv -> IO CInt
foreign import ccall iconv :: IConv -> Ptr (Ptr CChar) -> Ptr CSize -> Ptr (Ptr CChar) -> Ptr CSize -> IO CInt