Haskellで文字列を UTF-32 ⇔UTF-16 変換する。 - sirocco の書いてもすぐに忘れるメモ

IBM developerWorks:Unicodeエンコード方式 UTF-8、UTF-16、およびUTF-32間の相互運用方法を参考にUTF-32 ⇔UTF-16変換関数を作ってみました。
Windows COMの内部文字コードはUTF-16を使っています。
一方、HaskellはソースコードはUTF-8で書きますが内部ではUCS4(UTF-32)を使っています。UTF-16とUTF-32の関係は通常の英数字・半角カナ・漢字を使っているぶんにはほぼ同一と考えて問題ありませんので特別な漢字を使わなければそのままでも問題は発生しません。
しかし、UTF-16にはサロゲートペアと呼ばれる16ビットのコードを2つ組み合わせる拡張があります。この文字を使う場合はUCS4(UTF-32) ⇔UTF-16変換を行う必要があります。
この拡張文字を使わなければUTF-16とUTF-32のコードは同じものになるので変換する必要はありません。

--  ghc --make -Wall  -fno-warn-unused-do-bind  utf16.hs
-- http://www.ibm.com/developerworks/jp/java/library/j-u-encode.html
module Main where

import Data.Char
import Text.Printf
  -- UTF-16
  -- http://ja.wikipedia.org/wiki/UTF-16
  -- BMPに含まれるU+0000..U+D7FFとU+E000..U+FFFFは、そのまま符号単位1つで表す。
  --                           0b1101100000000000 0b1101110000000000
  --                           => 55296(0xD800)           =>56320(0xDC00)
  -- 000uuuuuxxxxxxxxxxxxxxxx  110110wwwwxxxxxx 110111xxxxxxxxxx wwww = uuuuu - 1
  -- ==========================================================
  -- 0x10000を引いた数
  -- > toBinS (0x2000B - 0x10000)                          -- >  "10000000000001011"
  -- 右へ10ビットシフト
  -- > toBinS ((0x2000B - 0x10000) `div` 0x400)            -- >            "1000000"
  -- > toBinS (((0x2000B - 0x10000) `div` 0x400) + 0xD800) -- >   "1101100001000000"
  -- ==========================================================
  -- 0x10000を引かない数
  -- > toBinS (0x2000B)                        -- > "100000000000001011"
  -- > toBinS (0x2000B `mod` 0x400)            -- >              " 1011"
  -- > toBinS ((0x2000B `mod` 0x400) + 0xDC00) -- >   "1101110000001011"
  -- ==========================================================

toBinS :: Int -> String
toBinS n=reverse $ map chr $ unfoldr (\b -> if b == 0 then Nothing else Just (b `mod` 2 + ord '0', b `div` 2)) n

utf32ToUtf16 :: [Char] -> [Int]
utf32ToUtf16 (x:xs) =
  if n <= 0xD7FF || (0xE000 <= n &&  n <= 0xFFFF)
    then n:utf32ToUtf16 xs
    else (((n - 0x10000) `div` 0x400) + 0xD800):((n `mod` 0x400) + 0xDC00):utf32ToUtf16 xs
    where n  = ord x
utf32ToUtf16 [] =[]

-- http://www.akanko.net/marimo/data/rfc/rfc2781-jp.txt
-- 2.2 UTF-16 の復号
--     UTF-16 から ISO 10646 文字値までの 1 つの文字の復号は、次のとおりに
--   続く。
--     W1 はテクストを表す整数列における次の16ビット整数とする。W2 は W1 の
--   後に続く (最終的な) の次の整数だとする。
--    1) W1 < 0xD800 または W1 > 0xDFFF なら、文字値 U は W1 の値とし、終了
--       する。
--    2) W1 が 0xD800〜0xDBFF かどうかを決定する。もしそうでなければ、その
--       シーケンスは間違っており、そして正当な文字は W1 を用いて得ることが
--       できない。終了する。
--    3) W2 (すなわちそのシーケンスが W1 で終わる) が無い、もしくは W2 が
--       0xDC00〜0xDFFF で無いなら、そのシーケンスは間違っている。終了する。
--    4) W1 の下位10ビットを上位10ビット、W2 の下位10ビットを下位10ビットと
--       して、20ビット無符号整数 U' を組み立てること。
--    5) 文字値 U を得るために U' に 0x10000 を加えること。終了する。

utf16ToUtf32 :: [Int] -> [Char]
utf16ToUtf32 (x:xs) = 
  if x < 0xD800 || x > 0xDFFF 
    then (chr x):utf16ToUtf32 xs
    else case xs of
           (y:ys) -> if (0xD800 <= y) && (y <= 0xDFFF)
                       then (chr (((x - 0xD800) * 0x400) + ((y - 0xDC00) +0x10000))):utf16ToUtf32 ys
                       else error "INVALID UTF-16 SEQUENCE"
           []     -> []
utf16ToUtf32 []     = []

main :: IO ()
main = do
   case utf32ToUtf16 [chr 0x2000B ] of
     [c1]    -> printf "%04X\n"    c1 
     [c1,c2] -> printf "%04X %04X\n" c1 c2    -- > D840 DC0B
     _       -> error "utf32ToUtf16 Error.\n"

   case utf16ToUtf32 [0xd840,0xdc0b] of
     [c1]    -> printf "%04X\n"    c1   -- > 2000B
     _       -> error "utf16ToUtf32 Error.\n"

【参考】