Implement /hex

src/UToy/Decode.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module UToy.Decode
+  ( decodeUtf8
+  ) where
+
+import Data.Bits (shiftL, (.&.), (.|.))
+import Data.Char (chr)
+import Data.Word (Word8)
+import Text.Printf (printf)
+
+decodeUtf8 :: [Word8] -> [([Word8], Either String Char)]
+decodeUtf8 = \case
+  (cu0:rest)
+    | isAscii cu0 ->
+      ([cu0], Right $ chr $ fromIntegral cu0) : decodeUtf8 rest
+  (cu0:cu1:rest)
+    | isTwoByteStarter cu0 && isContinuation cu1 ->
+      ( [cu0, cu1]
+      , Right $ chr $
+        fromIntegral (cu0 .&. 0b0001_1111) `shiftL` 6
+        .|. fromIntegral (cu1 .&. 0b0011_1111)
+      ) : decodeUtf8 rest
+  (cu0:cu1:cu2:rest)
+    | isThreeByteStarter cu0 && isContinuation cu1 && isContinuation cu2 ->
+      ( [cu0, cu1, cu2]
+      , Right $ chr $
+        fromIntegral (cu0 .&. 0b0000_1111) `shiftL` 12
+        .|. fromIntegral (cu1 .&. 0b0011_1111) `shiftL` 6
+        .|. fromIntegral (cu2 .&. 0b0011_1111)
+      ) : decodeUtf8 rest
+  (cu0:cu1:cu2:cu3:rest)
+    | isFourByteStarter cu0 && isContinuation cu1 && isContinuation cu2 && isContinuation cu3 ->
+      ( [cu0, cu1, cu2, cu3]
+      , let
+          codepoint = 
+            fromIntegral (cu0 .&. 0b0000_0111) `shiftL` 18
+            .|. fromIntegral (cu1 .&. 0b0011_1111) `shiftL` 12
+            .|. fromIntegral (cu2 .&. 0b0011_1111) `shiftL` 6
+            .|. fromIntegral (cu3 .&. 0b0011_1111)
+        in
+          if codepoint > 0x10_ffff then
+            Left $ printf "Code point U+%X would be too big (maximum: U+10FFFF)" codepoint
+          else
+            Right $ chr codepoint
+            
+      ) : decodeUtf8 rest
+  (cu0:rest) ->
+    ( [cu0]
+    , Left "Invalid start of code point"
+    ) : decodeUtf8 rest
+  [] ->
+    []
+
+  where
+    isAscii cu = cu .&. 0b1000_0000 == 0b0000_0000
+
+    isTwoByteStarter cu = cu .&. 0b1110_0000 == 0b1100_0000
+    isThreeByteStarter cu = cu .&. 0b1111_0000 == 0b1110_0000
+    isFourByteStarter cu = cu .&. 0b1111_1000 == 0b1111_0000
+
+    isContinuation cu = cu .&. 0b1100_0000 == 0b1000_0000

src/UToy/Parsers.hs

@@ -0,0 +1,31 @@
+module UToy.Parsers
+  ( parseHexBytes
+  ) where
+
+import Data.Char (isHexDigit, ord)
+import Data.Text (Text)
+import Data.Word (Word8)
+import Text.Printf (printf)
+
+import qualified Data.Attoparsec.Text as Atto
+
+parseHexBytes :: Text -> Either String [Word8]
+parseHexBytes = Atto.parseOnly $ hexBytes <* Atto.endOfInput
+
+hexBytes :: Atto.Parser [Word8]
+hexBytes = hexByte `Atto.sepBy` separators
+  where
+    hexByte = do
+      high <- hexDigit
+      low <- hexDigit
+      pure $ fromIntegral $ high * 16 + low
+
+    hexDigit = hexDigitToInt <$> Atto.satisfy isHexDigit
+
+    hexDigitToInt c
+      | '0' <= c && c <= '9' = ord c - ord '0'
+      | 'A' <= c && c <= 'F' = ord c - ord 'A' + 10
+      | 'a' <= c && c <= 'f' = ord c - ord 'a' + 10
+      | otherwise = error $ printf "not a hex digit: %c" c
+    
+    separators = Atto.skipMany $ Atto.satisfy $ Atto.inClass " +."