HaskellでUTF8エンコーディング

ビット演算の練習もかねて、ghciでputStrLnで日本語文字が出せないのもつらいので書いてみた。ghcのCharはunicode（16bit）だけど、putChar等がバイト列でのみしか扱えないので。

import Data.Char
import Data.Bits

utf8 :: String -> String
utf8 s = concatMap toUTF8 (toUCS4 s)

toUCS4 :: String -> [Int]
toUCS4 [] = []
toUCS4 (a:b:t) | 0xd800 <= av && av <= 0xdbff &&
                 0xdc00 <= bv && bv <= 0xdfff = unpair:(toUCS4 t)
                     where
                       av = ord a
                       bv = ord b
                       unpair = ((shiftL (av .&. (bits 10)) 10) .|.
                                 (bv .&. (bits 10))) + 0x10000
toUCS4 (a:t) = (ord a):(toUCS4 t)

toUTF8 :: Int -> String
toUTF8 chv = if chv < (bit 7) then [chr chv]
             else if chv < (bit 11) then [h 1, t 1]
             else if chv < (bit 16) then [h 2, t 2, t 1]
             else if chv < (bit 21) then [h 3, t 3, t 2, t 1]
             else if chv < (bit 26) then [h 4, t 4, t 3, t 2, t 1]
             else if chv < (bit 31) then [h 5, t 5, t 4, t 3, t 2, t 1]
             else undefined
    where
      t n = chr $ shiftR (chv .&. (bits (6 * n))) (6 * (n - 1)) .|. bit 7
      h n = chr $ shiftR (chv .&. mask) shifts .|.  head (7 - n)
          where
            shifts = 6 * n
            mask = bits (shifts + (6 - n))
            head 7 = bit 7
            head n = head (n + 1) .|. bit n

bits 0 = 0
bits n = bit (n - 1) .|. bits (n - 1)

で、

$ ghci utf8.hs
GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
Loading package base ... linking ... done.
[1 of 1] Compiling Main             ( utf8.hs, interpreted )
Ok, modules loaded: Main.
*Main> putStrLn $ utf8 "こんにちは"
こんにちは
*Main> 

みたいな感じ。サロゲートペア変換入れました。変な感じ。