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
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ImplicitParams #-}
{- | This module provides a replacement for the normal (unicode unaware) IO functions of haskell.
By using implicit parameters, it can be used almost as a drop-in replacement.
For example, consider the following simple echo program:
> main = do
> str <- getContents
> putStr str
To make this program process UTF-8 data, change the program to:
> {-# LANGUAGE ImplicitParams #-}
>
> import Prelude hiding (getContents,putStr)
> import System.IO.Encoding
> import Data.Encoding.UTF8
>
> main = do
> let ?enc = UTF8
> str <- getContents
> putStr str
Or, if you want to use the standard system encoding:
> {-# LANGUAGE ImplicitParams #-}
>
> import Prelude hiding (getContents,putStr)
> import System.IO.Encoding
>
> main = do
> e <- getSystemEncoding
> let ?enc = e
> str <- getContents
> putStr str
-}
module System.IO.Encoding
(getSystemEncoding
,getContents
,putStr
,putStrLn
,hPutStr
,hPutStrLn
,hGetContents
,readFile
,writeFile
,appendFile
,getChar
,hGetChar
,getLine
,hGetLine
,putChar
,hPutChar
,interact
,print
,hPrint) where
import Foreign.C.String
import Control.Monad.Reader (runReaderT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Encoding
import Prelude hiding (appendFile, getChar, getContents,
getLine, interact, print, putChar,
putStr, putStrLn, readFile, writeFile)
import System.IO (Handle, stdin, stdout)
-- | Like the normal 'System.IO.hGetContents', but decodes the input using an
-- encoding.
hGetContents :: (Encoding e,?enc :: e) => Handle -> IO String
hGetContents h = do
str <- LBS.hGetContents h
return $ decodeLazyByteString ?enc str
getContents :: (Encoding e,?enc :: e) => IO String
getContents = do
str <- LBS.getContents
return $ decodeLazyByteString ?enc str
putStr :: (Encoding e,?enc :: e) => String -> IO ()
putStr = hPutStr stdout
putStrLn :: (Encoding e,?enc :: e) => String -> IO ()
putStrLn = hPutStrLn stdout
-- | Like the normal 'System.IO.hPutStr', but encodes the output using an
-- encoding.
hPutStr :: (Encoding e,?enc :: e) => Handle -> String -> IO ()
hPutStr h str = LBS.hPut h (encodeLazyByteString ?enc str)
hPutStrLn :: (Encoding e,?enc :: e) => Handle -> String -> IO ()
hPutStrLn h str = do
LBS.hPut h (encodeLazyByteString ?enc str)
LBS.hPut h (encodeLazyByteString ?enc "\n")
print :: (Encoding e,Show a,?enc :: e) => a -> IO ()
print = hPrint stdout
hPrint :: (Encoding e,Show a,?enc :: e) => Handle -> a -> IO ()
hPrint h x = hPutStrLn h (show x)
readFile :: (Encoding e,?enc :: e) => FilePath -> IO String
readFile fn = LBS.readFile fn >>= return.(decodeLazyByteString ?enc)
writeFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
writeFile fn str = LBS.writeFile fn $ encodeLazyByteString ?enc str
appendFile :: (Encoding e,?enc :: e) => FilePath -> String -> IO ()
appendFile fn str = LBS.appendFile fn $ encodeLazyByteString ?enc str
getChar :: (Encoding e,?enc :: e) => IO Char
getChar = hGetChar stdin
hGetChar :: (Encoding e,?enc :: e) => Handle -> IO Char
hGetChar h = runReaderT (decodeChar ?enc) h
getLine :: (Encoding e,?enc :: e) => IO String
getLine = hGetLine stdin
hGetLine :: (Encoding e,?enc :: e) => Handle -> IO String
hGetLine h = do
line <- BS.hGetLine h
return $ decodeStrictByteString ?enc line
putChar :: (Encoding e,?enc :: e) => Char -> IO ()
putChar = hPutChar stdout
hPutChar :: (Encoding e,?enc :: e) => Handle -> Char -> IO ()
hPutChar h c = runReaderT (encodeChar ?enc c) h
interact :: (Encoding e,?enc :: e) => (String -> String) -> IO ()
interact f = do
line <- hGetLine stdin
hPutStrLn stdout (f line)
#ifndef mingw32_HOST_OS
foreign import ccall "system_encoding.h get_system_encoding"
get_system_encoding :: IO CString
#endif
-- | On unix machines, returns the system's currently configured text encoding,
-- or Nothing if there was an error. On Windows, currently always returns Nothing.
getSystemEncoding :: IO (Maybe DynEncoding)
getSystemEncoding = do
#ifndef mingw32_HOST_OS
enc <- get_system_encoding
str <- peekCString enc
return $ encodingFromStringExplicit str
#else
return Nothing
#endif
|
