1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
|
{-# 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
#if HAVE_ICONV_H
# include <iconv.h>
#endif
module UI.HSCurses.IConv {-(
IConv,
iconv,
iconv_,
with_iconv,
to_unicode,
from_unicode,
to_unicode_,
from_unicode_
)-} where
import UI.HSCurses.CWString ( peekUTF8StringLen, withUTF8StringLen )
import Foreign
import Foreign.C
import Foreign.C.String
import Control.Exception ( Exception, try, bracket )
type IConv = Ptr () --(#type iconv_t)
err_ptr :: Ptr b -> Bool
err_ptr p = p == (plusPtr nullPtr (-1))
throw_if_not_2_big :: String -> IO CSize -> IO CSize
throw_if_not_2_big s r_ = do
r <- 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 to from =
withCString to $
\cto -> withCString from $
\cfrom -> do
throwErrnoIf err_ptr "iconv_open"
$ c_iconv_open cto cfrom
iconv_close :: IConv -> IO ()
iconv_close ic =
throwErrnoIfMinus1_ "iconv_close" $ c_iconv_close ic
outbuf_size :: Int
outbuf_size = 1024
do_iconv :: ((Ptr a, Int) -> IO String) -> IConv -> (Ptr b, Int) -> IO String
do_iconv get_string_fn ic (inbuf, inbuf_bytes) =
alloca $ \inbuf_ptr ->
alloca $ \inbytesleft_ptr ->
alloca $ \outbuf_ptr ->
alloca $ \outbytesleft_ptr ->
allocaBytes outbuf_size $ \outbuf -> do
poke (inbytesleft_ptr :: Ptr CSize) (fromIntegral inbuf_bytes)
poke inbuf_ptr inbuf
let loop acc = do
poke (outbytesleft_ptr :: Ptr CSize) (fromIntegral outbuf_size)
poke outbuf_ptr outbuf
ret <- throw_if_not_2_big "c_iconv" $
c_iconv ic inbuf_ptr inbytesleft_ptr
outbuf_ptr 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)
loop []
with_iconv :: String -> String -> (IConv -> IO a) -> IO a
with_iconv to from fn =
bracket (iconv_open to from) iconv_close fn
iconv_ :: String -> IConv -> IO String
iconv_ str ic =
withCStringLen str $ do_iconv peekCStringLen ic
-- between 8-bit encodings only
iconv :: Exception e => String -> String -> String -> Either e String
iconv to from str =
unsafePerformIO $ try $ with_iconv to from (iconv_ str)
#ifdef HAVE_WCHAR_H
{-
type CUni = (#type wchar_t)
cuni_size = (#size wchar_t)
unicode_charset = "WCHAR_T"
chartocuni :: Char -> CUni
chartocuni = fromIntegral . ord
cunitochar :: CUni -> Char
cunitochar = chr . fromIntegral
-}
cuni_charset :: [Char]
cuni_charset = "WCHAR_T"
peek_cuni :: (Ptr (#type wchar_t), Int) -> IO String
peek_cuni (buf, bytes) = do
let (chars, rembytes) = bytes `divMod` (#size wchar_t)
if rembytes /= 0 then
error "Conversion result contains remainder bytes."
else
peekCWStringLen (buf, chars)
--liftM (map cunitochar) $ peekArray chars buf
with_cuni :: String -> ((Ptr (#type wchar_t), Int) -> IO String) -> IO String
with_cuni str f =
withCWStringLen str $ \(s, l) -> f (s, l*(#size wchar_t))
--withArray (map chartocuni str) $ \s -> f (s, l*cuni_size)
#else
-- no CF_WCHAR_SUPPORT
-- Due to endianness problems, it is easiest to do this through UTF-8
cuni_charset :: [Char]
cuni_charset = "UTF-8"
peek_cuni :: CStringLen -> IO String
peek_cuni = peekUTF8StringLen
with_cuni :: [Char] -> (CStringLen -> IO a) -> IO a
with_cuni = withUTF8StringLen
#endif
to_unicode_ :: String -> String -> IO String
to_unicode_ from str =
with_iconv cuni_charset from $
\ic -> withCStringLen str $ do_iconv peek_cuni ic
to_unicode :: Exception e => String -> String -> Either e String
to_unicode from str =
unsafePerformIO $ try $ to_unicode_ from str
from_unicode_ :: String -> String -> IO String
from_unicode_ to str =
with_iconv to cuni_charset $
\ic -> with_cuni str $ do_iconv peekCStringLen ic
from_unicode :: Exception e => String -> String -> Either e String
from_unicode from str =
unsafePerformIO $ try $ from_unicode_ from str
#ifndef ICONV_LIB_PREFIX
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
#else
foreign import ccall unsafe "iconv.h libiconv_open" c_iconv_open
:: CString -> CString -> IO IConv
foreign import ccall unsafe "iconv.h libiconv_close" c_iconv_close
:: IConv -> IO CInt
foreign import ccall unsafe "iconv.h libiconv" c_iconv
:: IConv -> Ptr a -> Ptr CSize -> Ptr b -> Ptr CSize -> IO CSize
#endif
|
