encoding001.hs 2.01 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
import Control.Monad
import System.IO
import GHC.IO.Encoding
import GHC.IO.Handle
import Data.Bits
import Data.Word
import Data.Char
import System.FilePath
import System.Exit

file = "encoding001"

encodings = [(utf8,   "utf8"), 
Simon Marlow's avatar
Simon Marlow committed
14
             (utf8_bom,"utf8_bom"),
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
             (utf16,  "utf16"),
             (utf16le,"utf16le"),
             (utf16be,"utf16be"),
             (utf32,  "utf32"),
             (utf32le,"utf32le"),
             (utf32be,"utf32be")]

main = do
  -- make a UTF-32BE file
  h <- openBinaryFile (file <.> "utf32be") WriteMode
  let expand32 :: Word32 -> [Char]
      expand32 x = [
          chr (fromIntegral (x `shiftR` 24) .&. 0xff),
          chr (fromIntegral (x `shiftR` 16) .&. 0xff),
          chr (fromIntegral (x `shiftR` 8)  .&. 0xff),
          chr (fromIntegral x .&. 0xff) ]
  hPutStr h (concatMap expand32 [ 0, 32 .. 0xD7ff ])
  hPutStr h (concatMap expand32 [ 0xE000, 0xE000+32 .. 0x10FFFF ])
  hClose h

  -- convert the UTF-32BE file into each other encoding
  forM_ encodings $ \(enc,name) -> do
     when (name /=  "utf32be") $ do
       hin <- openFile (file <.> "utf32be") ReadMode
       hSetEncoding hin utf32be
       hout <- openFile (file <.> name) WriteMode
       hSetEncoding hout enc
       hGetContents hin >>= hPutStr hout
       hClose hin
       hClose hout

  forM_ [ (from,to) | from <- encodings, to <- encodings, snd from /= snd to ]
      $ \((fromenc,fromname),(toenc,toname)) -> do
     hin <- openFile (file <.> fromname) ReadMode
     hSetEncoding hin fromenc
     hout <- openFile (file <.> toname <.> fromname) WriteMode
     hSetEncoding hout toenc
     hGetContents hin >>= hPutStr hout
     hClose hin
     hClose hout

     h1 <- openBinaryFile (file <.> toname) ReadMode
     h2 <- openBinaryFile (file <.> toname <.> fromname) ReadMode
     str1 <- hGetContents h1
     str2 <- hGetContents h2
     when (str1 /= str2) $ do
       putStrLn (file <.> toname ++ " and " ++ file <.> toname <.> fromname ++ " differ")
       exitWith (ExitFailure 1)
     hClose h1
     hClose h2