import Data.Bits
import Data.Char
import Numeric
char ch = [ch]
text str = str
a <> b = a ++ b
escapeChar :: Char -> String
escapeChar ch =
case lookup ch specialCharsMap of
Just escaped -> text escaped
Nothing | ascii -> char ch
| uniSingle -> text (uniSingleEsc val)
| uniPair -> text (uniPairEsc val)
| otherwise -> error "Unexpected character " ++ [ch]
where
-- Predicate functions
ascii = (ch >= ' ' && ch <= '~')
uniSingle = (not ascii && val <= 0xFFFF)
uniPair = (not ascii && val > 0xFFFF)
-- Escape functions
uniSingleEsc n = "\\u" ++ (replicate (4 - length h) '0') ++ h
where h = showHex n ""
uniPairEsc n = (uniSingleEsc (a + 0xd800)) ++ (uniSingleEsc (b + 0xdc00))
where a = (n `shiftR` 10) .&. 0x3ff
b = n .&. 0x3ff
-- Helper data
val = ord ch
specialCharsMap = zipWith ch "\b\n\f\r\t\\\"/" "bnfrt\\\"/"
where ch a b = (a, [ '\\' , b])
main = do
putStrLn (concat (escapeChar `map` "abc \a\b\n \x123 \x10123"))