showCStr :: String -> String
showCStr s = '"' : foldr ((++) . showChar) "\"" s
  where
    showChar :: Char -> String
    showChar '"'  = "\\\""
    showChar '\\' = "\\\\"
    showChar c
        -- Note: we need the double quotes around the codes because otherwise
        -- "\n3" would get encoded as "\x0a3", which is incorrect.
        -- Instead, we opt for "\x0a""3" and let the C compiler deal with it.
        | ord c < 0x20  = showUTF8 (ord c)
        | ord c < 0x7f  = [c]    -- 0x7f = \DEL
        | otherwise = showHexes (utf8bytes (ord c))

    showUTF8 c = "\"\"\\x" ++ pad (showHex c "") ++ "\"\""
    showHexes = foldr ((++) . showUTF8) ""

    utf8bytes :: Int -> [Int]
    utf8bytes x
        | x <= 0x7f     = [x]
        | x <= 0x7ff    = let (y : ys) = split [] 2 x in (y .|. 0xc0) : map (.|. 0x80) ys
        | x <= 0xffff   = let (y : ys) = split [] 3 x in (y .|. 0xe0) : map (.|. 0x80) ys
        | x <= 0x10ffff = let (y : ys) = split [] 4 x in (y .|. 0xf0) : map (.|. 0x80) ys
        | otherwise = error $ "Invalid Unicode code point U+" ++ showHex x ""
      where
        split acc 1 x = x : acc
        split acc i x = split (x .&. 0x3f : acc) (i - 1) (shiftR x 6)

    pad :: String -> String
    pad s = case length s of
                 1 -> "0" ++ s
                 2 -> s
                 _ -> error $ "Can't happen: String of invalid length " ++ show s
showCStr :: String -> String
showCStr s = '"' : foldr ((++) . showChar) "\"" s
  where
    showChar :: Char -> String
    showChar '"'  = "\\\""
    showChar '\\' = "\\\\"
    showChar c
        -- Note: we need the double quotes around the codes because otherwise
        -- "\n3" would get encoded as "\x0a3", which is incorrect.
        -- Instead, we opt for "\x0a""3" and let the C compiler deal with it.
        | ord c < 0x20  = showUTF8 (ord c)
        | ord c < 0x7f  = [c]    -- 0x7f = \DEL
        | otherwise = showHexes (utf8bytes (ord c))

    showUTF8 c = "\"\"\\x" ++ pad (showHex c "") ++ "\"\""
    showHexes = foldr ((++) . showUTF8) ""

    utf8bytes :: Int -> [Int]
    utf8bytes x
        | x <= 0x7f     = [x]
        | x <= 0x7ff    = let (y : ys) = split [] 2 x in (y .|. 0xc0) : map (.|. 0x80) ys
        | x <= 0xffff   = let (y : ys) = split [] 3 x in (y .|. 0xe0) : map (.|. 0x80) ys
        | x <= 0x10ffff = let (y : ys) = split [] 4 x in (y .|. 0xf0) : map (.|. 0x80) ys
        | otherwise = error $ "Invalid Unicode code point U+" ++ showHex x ""
      where
        split acc 1 x = x : acc
        split acc i x = split (x .&. 0x3f : acc) (i - 1) (shiftR x 6)

    pad :: String -> String
    pad s = case length s of
                 1 -> "0" ++ s
                 2 -> s
                 _ -> error $ "Can't happen: String of invalid length " ++ show s
showCStr s = '"' : foldr ((++) . showChar) "\"" s
  where
    showChar :: Char -> String
    showChar '"'  = "\\\""
    showChar '\\' = "\\\\"
    showChar c
        -- Note: we need the double quotes around the codes because otherwise
        -- "\n3" would get encoded as "\x0a3", which is incorrect.
        -- Instead, we opt for "\x0a""3" and let the C compiler deal with it.
        | ord c < 0x20  = showUTF8 (ord c)
        | ord c < 0x7f  = [c]    -- 0x7f = \DEL
        | otherwise = showHexes (utf8bytes (ord c))

    showUTF8 c = "\"\"\\x" ++ pad (showHex c "") ++ "\"\""
    showHexes = foldr ((++) . showUTF8) ""

    utf8bytes :: Int -> [Int]
    utf8bytes x
        | x <= 0x7f     = [x]
        | x <= 0x7ff    = let (y : ys) = split [] 2 x in (y .|. 0xc0) : map (.|. 0x80) ys
        | x <= 0xffff   = let (y : ys) = split [] 3 x in (y .|. 0xe0) : map (.|. 0x80) ys
        | x <= 0x10ffff = let (y : ys) = split [] 4 x in (y .|. 0xf0) : map (.|. 0x80) ys
        | otherwise = error $ "Invalid Unicode code point U+" ++ showHex x ""
      where
        split acc 1 x = x : acc
        split acc i x = split (x .&. 0x3f : acc) (i - 1) (shiftR x 6)

    pad :: String -> String
    pad s = case length s of
                 1 -> "0" ++ s
                 2 -> s
                 _ -> error $ "Can't happen: String of invalid length " ++ show s