fixup! fixup! Implemented TH splices for validated ByteString literals

Andrew Lelechenko review fixes

Author: hs-viktor

Data/ByteString/Internal/Type.hs

@@ -532,8 +532,35 @@ packUptoLenChars len cs0 =
           go !p (c:cs)          = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs
       in go p0 cs0
 
+#if MIN_VERSION_template_haskell(2,17,0)
+type THLift a = forall m. (MonadFail m, TH.Quote m) => TH.Code m a
+
+liftTyped :: forall a m. (MonadFail m, TH.Quote m, TH.Lift a) => a -> TH.Code m a
+liftTyped = TH.liftTyped
+
+liftCode :: forall a m. (MonadFail m, TH.Quote m) => m (TH.TExp a) -> TH.Code m a
+liftCode = TH.liftCode
+#else
+type THLift a = TH.Q (TH.TExp a)
+
+liftTyped :: forall a. TH.Lift a => a -> TH.Q (TH.TExp a)
+liftTyped = TH.unsafeTExpCoerce . TH.lift
+
+liftCode :: forall a. TH.Q TH.Exp -> TH.Q (TH.TExp a)
+liftCode = TH.unsafeTExpCoerce
+#endif
+
 data S2W = Octets {-# UNPACK #-} !Int [Word8]
+           -- ^ Decoded some octets (<= 0xFF)
          | Hichar {-# UNPACK #-} !Int {-# UNPACK #-} !Word
+           -- ^ Found a high char (> 0xFF)
+
+data H2W = Hex {-# UNPACK #-} !Int [Word8]
+           -- ^ Decoded some full bytes (nibble pairs)
+         | Odd {-# UNPACK #-} !Int {-# UNPACK #-} !Word [Word8]
+           -- ^ Decoded a nibble plus some full bytes
+         | Bad {-# UNPACK #-} !Int {-# UNPACK #-} !Word
+           -- ^ Found a non hex-digit character
 
 -- | Template Haskell splice to convert string constants to compile-time
 -- ByteString literals.  Unlike the 'IsString' instance, the input string
@@ -546,39 +573,20 @@ data S2W = Octets {-# UNPACK #-} !Int [Word8]
 -- > ehloCmd :: ByteString
 -- > ehloCmd = $$(literalFromChar8 "EHLO")
 --
-#if MIN_VERSION_template_haskell(2,17,0)
-liftTyped :: forall a m. (TH.Lift a, TH.Quote m) => a -> TH.Code m a
-liftTyped = TH.liftTyped
-
-liftCode :: forall a m. m (TH.TExp a) -> TH.Code m a
-liftCode = TH.liftCode
-
-literalFromChar8 :: (MonadFail m, TH.Quote m) => String -> TH.Code m ByteString
-#else
-liftTyped :: forall a. TH.Lift a => a -> TH.Q (TH.TExp a)
-liftTyped = TH.unsafeTExpCoerce . TH.lift
-
-liftCode :: forall a. TH.Q TH.Exp -> TH.Q (TH.TExp a)
-liftCode = TH.unsafeTExpCoerce
-
-literalFromChar8 :: String -> TH.Q (TH.TExp ByteString)
-#endif
+literalFromChar8 :: String -> THLift ByteString
 literalFromChar8 "" = [||empty||]
 literalFromChar8 s = case foldr' op (Octets 0 []) s of
     Octets n ws -> liftTyped (unsafePackLenBytes n ws)
     Hichar i w  -> liftCode $ fail $ "non-octet character '\\" ++
         show w ++ "' at offset: " ++ show i
   where
-    op (fromIntegral . fromEnum -> !w) acc
+    op :: Char -> S2W -> S2W
+    op (fromIntegral . fromEnum -> !(w :: Word)) acc
         | w <= 0xff = case acc of
             Octets i ws -> Octets (i + 1) (fromIntegral w : ws)
             Hichar i w' -> Hichar (i + 1) w'
         | otherwise = Hichar 0 w
 
-data H2W = Hex {-# UNPACK #-} !Int [Word8]
-         | Odd {-# UNPACK #-} !Int {-# UNPACK #-} !Word [Word8]
-         | Bad {-# UNPACK #-} !Int {-# UNPACK #-} !Word
-
 -- | Template Haskell splice to convert hex-encoded string constants to compile-time
 -- ByteString literals.  The input string is validated to ensure that it consists of
 -- an even number of valid hexadecimal digits (case insensitive).
@@ -589,11 +597,7 @@ data H2W = Hex {-# UNPACK #-} !Int [Word8]
 -- > ehloCmd :: ByteString
 -- > ehloCmd = $$(literalFromHex "45484c4F")
 --
-#if MIN_VERSION_template_haskell(2,17,0)
-literalFromHex :: (MonadFail m, TH.Quote m) => String -> TH.Code m ByteString
-#else
-literalFromHex :: String -> TH.Q (TH.TExp ByteString)
-#endif
+literalFromHex :: String -> THLift ByteString
 literalFromHex "" = [||empty||]
 literalFromHex s =
     case foldr' op (Hex 0 []) s of
@@ -612,7 +616,8 @@ literalFromHex s =
     c2d :: Char -> Word
     c2d c = fromIntegral (fromEnum c) - 0x30
 
-    op (c2d -> d) acc
+    op :: Char -> H2W -> H2W
+    op (c2d -> !(d :: Word)) acc
         | d <= 9 = case acc of
             Hex i ws    -> Odd i d ws
             Odd i lo ws -> Hex (i+1) $ fromIntegral ((d `shiftL` 4 .|. lo)) : ws