{-# LINE 1 "UI/HSCurses/IConv.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

--
-- Copyright (c) 2004 Tuomo Valkonen <tuomov at iki dot fi>
-- Copyright (c) 2004 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2005-2011 Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA


-- | Iconv binding


{-# LINE 28 "UI/HSCurses/IConv.hsc" #-}

module UI.HSCurses.IConv where

import UI.HSCurses.CWString (peekUTF8StringLen, withUTF8StringLen)

import System.IO.Unsafe (unsafePerformIO)


{-# LINE 38 "UI/HSCurses/IConv.hsc" #-}
import Foreign

{-# LINE 40 "UI/HSCurses/IConv.hsc" #-}

import Control.Exception (Exception, bracket, try)
import Foreign.C

type IConv = Ptr () -- (#type iconv_t)

err_ptr :: Ptr b -> Bool
err_ptr :: forall b. Ptr b -> Bool
err_ptr Ptr b
p = Ptr b
p Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== (Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Any
forall a. Ptr a
nullPtr (-Int
1))

throw_if_not_2_big :: String -> IO CSize -> IO CSize
throw_if_not_2_big :: String -> IO CSize -> IO CSize
throw_if_not_2_big String
s IO CSize
r_ = do
    r <- IO CSize
r_
    if r == fromIntegral (-1 :: Int)
        then do
            errno <- getErrno
            if errno /= e2BIG
                then
                    throwErrno s
                else
                    return r
        else
            return r

iconv_open :: String -> String -> IO IConv
iconv_open :: String -> String -> IO IConv
iconv_open String
to String
from =
    String -> (CString -> IO IConv) -> IO IConv
forall a. String -> (CString -> IO a) -> IO a
withCString String
to ((CString -> IO IConv) -> IO IConv)
-> (CString -> IO IConv) -> IO IConv
forall a b. (a -> b) -> a -> b
$
        \CString
cto -> String -> (CString -> IO IConv) -> IO IConv
forall a. String -> (CString -> IO a) -> IO a
withCString String
from ((CString -> IO IConv) -> IO IConv)
-> (CString -> IO IConv) -> IO IConv
forall a b. (a -> b) -> a -> b
$
            \CString
cfrom ->
                do
                    (IConv -> Bool) -> String -> IO IConv -> IO IConv
forall a. (a -> Bool) -> String -> IO a -> IO a
throwErrnoIf IConv -> Bool
forall b. Ptr b -> Bool
err_ptr String
"iconv_open"
                    (IO IConv -> IO IConv) -> IO IConv -> IO IConv
forall a b. (a -> b) -> a -> b
$ CString -> CString -> IO IConv
c_iconv_open CString
cto CString
cfrom

iconv_close :: IConv -> IO ()
iconv_close :: IConv -> IO ()
iconv_close IConv
ic =
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"iconv_close" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ IConv -> IO CInt
c_iconv_close IConv
ic

outbuf_size :: Int
outbuf_size :: Int
outbuf_size = Int
1024

do_iconv :: ((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv :: forall a b.
((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv (Ptr a, Int) -> IO String
get_string_fn IConv
ic (Ptr b
inbuf, Int
inbuf_bytes) =
    (Ptr (Ptr b) -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr b) -> IO String) -> IO String)
-> (Ptr (Ptr b) -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr b)
inbuf_ptr ->
        (Ptr CSize -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO String) -> IO String)
-> (Ptr CSize -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
inbytesleft_ptr ->
            (Ptr (Ptr Any) -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr Any) -> IO String) -> IO String)
-> (Ptr (Ptr Any) -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr Any)
outbuf_ptr ->
                (Ptr CSize -> IO String) -> IO String
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO String) -> IO String)
-> (Ptr CSize -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr CSize
outbytesleft_ptr ->
                    Int -> (Ptr Any -> IO String) -> IO String
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
outbuf_size ((Ptr Any -> IO String) -> IO String)
-> (Ptr Any -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr Any
outbuf -> do
                        Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CSize
inbytesleft_ptr :: Ptr CSize) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inbuf_bytes)
                        Ptr (Ptr b) -> Ptr b -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr b)
inbuf_ptr Ptr b
inbuf
                        let loop :: String -> IO String
loop String
acc = do
                                Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CSize
outbytesleft_ptr :: Ptr CSize) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
outbuf_size)
                                Ptr (Ptr Any) -> Ptr Any -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Any)
outbuf_ptr Ptr Any
outbuf
                                ret <-
                                    String -> IO CSize -> IO CSize
throw_if_not_2_big String
"c_iconv" (IO CSize -> IO CSize) -> IO CSize -> IO CSize
forall a b. (a -> b) -> a -> b
$
                                        IConv
-> Ptr (Ptr b)
-> Ptr CSize
-> Ptr (Ptr Any)
-> Ptr CSize
-> IO CSize
forall a b.
IConv -> Ptr a -> Ptr CSize -> Ptr b -> Ptr CSize -> IO CSize
c_iconv
                                            IConv
ic
                                            Ptr (Ptr b)
inbuf_ptr
                                            Ptr CSize
inbytesleft_ptr
                                            Ptr (Ptr Any)
outbuf_ptr
                                            Ptr CSize
outbytesleft_ptr
                                left <- peek outbytesleft_ptr
                                res <- get_string_fn (castPtr outbuf, outbuf_size - fromIntegral left)
                                if ret == fromIntegral (-1 :: Int)
                                    then
                                        loop (acc ++ res)
                                    else
                                        return (acc ++ res)
                        String -> IO String
loop []

with_iconv :: String -> String -> (IConv -> IO a) -> IO a
with_iconv :: forall a. String -> String -> (IConv -> IO a) -> IO a
with_iconv String
to String
from IConv -> IO a
fn =
    IO IConv -> (IConv -> IO ()) -> (IConv -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> String -> IO IConv
iconv_open String
to String
from) IConv -> IO ()
iconv_close IConv -> IO a
fn

iconv_ :: String -> IConv -> IO String
iconv_ :: String -> IConv -> IO String
iconv_ String
str IConv
ic =
    String -> (CStringLen -> IO String) -> IO String
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO String) -> IO String)
-> (CStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ (CStringLen -> IO String) -> IConv -> CStringLen -> IO String
forall a b.
((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv CStringLen -> IO String
peekCStringLen IConv
ic

-- between 8-bit encodings only
iconv :: (Exception e) => String -> String -> String -> Either e String
iconv :: forall e.
Exception e =>
String -> String -> String -> Either e String
iconv String
to String
from String
str =
    IO (Either e String) -> Either e String
forall a. IO a -> a
unsafePerformIO (IO (Either e String) -> Either e String)
-> IO (Either e String) -> Either e String
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either e String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either e String))
-> IO String -> IO (Either e String)
forall a b. (a -> b) -> a -> b
$ String -> String -> (IConv -> IO String) -> IO String
forall a. String -> String -> (IConv -> IO a) -> IO a
with_iconv String
to String
from (String -> IConv -> IO String
iconv_ String
str)


{-# LINE 139 "UI/HSCurses/IConv.hsc" #-}

-- no CF_WCHAR_SUPPORT

-- Due to endianness problems, it is easiest to do this through UTF-8

cuni_charset :: [Char]
cuni_charset :: String
cuni_charset = String
"UTF-8"

peek_cuni :: CStringLen -> IO String
peek_cuni :: CStringLen -> IO String
peek_cuni = CStringLen -> IO String
peekUTF8StringLen

with_cuni :: [Char] -> (CStringLen -> IO a) -> IO a
with_cuni :: forall a. String -> (CStringLen -> IO a) -> IO a
with_cuni = String -> (CStringLen -> IO a) -> IO a
forall a. String -> (CStringLen -> IO a) -> IO a
withUTF8StringLen


{-# LINE 154 "UI/HSCurses/IConv.hsc" #-}

to_unicode_ :: String -> String -> IO String
to_unicode_ :: String -> String -> IO String
to_unicode_ String
from String
str =
    String -> String -> (IConv -> IO String) -> IO String
forall a. String -> String -> (IConv -> IO a) -> IO a
with_iconv String
cuni_charset String
from ((IConv -> IO String) -> IO String)
-> (IConv -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
        \IConv
ic -> String -> (CStringLen -> IO String) -> IO String
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
str ((CStringLen -> IO String) -> IO String)
-> (CStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ (CStringLen -> IO String) -> IConv -> CStringLen -> IO String
forall a b.
((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv CStringLen -> IO String
peek_cuni IConv
ic

to_unicode :: (Exception e) => String -> String -> Either e String
to_unicode :: forall e. Exception e => String -> String -> Either e String
to_unicode String
from String
str =
    IO (Either e String) -> Either e String
forall a. IO a -> a
unsafePerformIO (IO (Either e String) -> Either e String)
-> IO (Either e String) -> Either e String
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either e String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either e String))
-> IO String -> IO (Either e String)
forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
to_unicode_ String
from String
str

from_unicode_ :: String -> String -> IO String
from_unicode_ :: String -> String -> IO String
from_unicode_ String
to String
str =
    String -> String -> (IConv -> IO String) -> IO String
forall a. String -> String -> (IConv -> IO a) -> IO a
with_iconv String
to String
cuni_charset ((IConv -> IO String) -> IO String)
-> (IConv -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$
        \IConv
ic -> String -> (CStringLen -> IO String) -> IO String
forall a. String -> (CStringLen -> IO a) -> IO a
with_cuni String
str ((CStringLen -> IO String) -> IO String)
-> (CStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ (CStringLen -> IO String) -> IConv -> CStringLen -> IO String
forall a b.
((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv CStringLen -> IO String
peekCStringLen IConv
ic

from_unicode :: (Exception e) => String -> String -> Either e String
from_unicode :: forall e. Exception e => String -> String -> Either e String
from_unicode String
from String
str =
    IO (Either e String) -> Either e String
forall a. IO a -> a
unsafePerformIO (IO (Either e String) -> Either e String)
-> IO (Either e String) -> Either e String
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either e String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either e String))
-> IO String -> IO (Either e String)
forall a b. (a -> b) -> a -> b
$ String -> String -> IO String
from_unicode_ String
from String
str


{-# LINE 174 "UI/HSCurses/IConv.hsc" #-}

foreign import ccall unsafe "iconv.h iconv_open"
    c_iconv_open ::
        CString -> CString -> IO IConv

foreign import ccall unsafe "iconv.h iconv_close"
    c_iconv_close ::
        IConv -> IO CInt

foreign import ccall unsafe "iconv.h iconv"
    c_iconv ::
        IConv -> Ptr a -> Ptr CSize -> Ptr b -> Ptr CSize -> IO CSize

{-# LINE 200 "UI/HSCurses/IConv.hsc" #-}