Merge pull request #67 from tfausak/gh-66-utf-8

Add `Witch.Encoding.UTF_8`
2024-11-26 09:43:03 +03:00 · 2022-10-07 08:45:07 -05:00 · 2022-10-07 08:45:07 -05:00 · 186e722687
commit 186e722687
parent c5c6273bed 64fd2f6716
4 changed files with 147 additions and 139 deletions
--- a/source/library/Witch/Encoding.hs
+++ b/source/library/Witch/Encoding.hs
@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+
+module Witch.Encoding where
+
+import qualified Data.Tagged as Tagged
+
+-- | <https://en.wikipedia.org/wiki/UTF-8>
+type UTF_8 = Tagged.Tagged "UTF-8"
--- a/source/library/Witch/Instances.hs
+++ b/source/library/Witch/Instances.hs
@ -1,4 +1,3 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds #-}
@ -38,6 +37,7 @@ import qualified Data.Word as Word
 import qualified GHC.Float as Float
 import qualified Numeric
 import qualified Numeric.Natural as Natural
+import qualified Witch.Encoding as Encoding
 import qualified Witch.From as From
 import qualified Witch.TryFrom as TryFrom
 import qualified Witch.TryFromException as TryFromException
@ -1039,24 +1039,6 @@ instance From.From ByteString.ByteString LazyByteString.ByteString where
 instance From.From ByteString.ByteString ShortByteString.ShortByteString where
  from = ShortByteString.toShort

-- | Uses 'Text.decodeUtf8''.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" ByteString.ByteString) Text.Text where
-  tryFrom = Utility.eitherTryFrom $ Text.decodeUtf8' . From.from
-
-- | Converts via 'Text.Text'.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" ByteString.ByteString) LazyText.Text where
-  tryFrom =
-    Utility.eitherTryFrom $
-      fmap (Utility.into @LazyText.Text)
-        . Utility.tryInto @Text.Text
-
-- | Converts via 'Text.Text'.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" ByteString.ByteString) String where
-  tryFrom =
-    Utility.eitherTryFrom $
-      fmap (Utility.into @String)
-        . Utility.tryInto @Text.Text
-
 -- LazyByteString

 -- | Uses 'LazyByteString.pack'.
@ -1071,24 +1053,6 @@ instance From.From LazyByteString.ByteString [Word.Word8] where
 instance From.From LazyByteString.ByteString ByteString.ByteString where
  from = LazyByteString.toStrict

-- | Uses 'LazyText.decodeUtf8''.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" LazyByteString.ByteString) LazyText.Text where
-  tryFrom = Utility.eitherTryFrom $ LazyText.decodeUtf8' . From.from
-
-- | Converts via 'LazyText.Text'.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" LazyByteString.ByteString) Text.Text where
-  tryFrom =
-    Utility.eitherTryFrom $
-      fmap (Utility.into @Text.Text)
-        . Utility.tryInto @LazyText.Text
-
-- | Converts via 'LazyText.Text'.
-instance TryFrom.TryFrom (Tagged.Tagged "UTF-8" LazyByteString.ByteString) String where
-  tryFrom =
-    Utility.eitherTryFrom $
-      fmap (Utility.into @String)
-        . Utility.tryInto @LazyText.Text
-
 -- ShortByteString

 -- | Uses 'ShortByteString.pack'.
@ -1109,28 +1073,12 @@ instance From.From ShortByteString.ShortByteString ByteString.ByteString where
 instance From.From Text.Text LazyText.Text where
  from = LazyText.fromStrict

-- | Uses 'Text.encodeUtf8'.
-instance From.From Text.Text (Tagged.Tagged "UTF-8" ByteString.ByteString) where
-  from = From.from . Text.encodeUtf8
-
-- | Converts via 'ByteString.ByteString'.
-instance From.From Text.Text (Tagged.Tagged "UTF-8" LazyByteString.ByteString) where
-  from = fmap From.from . Utility.into @(Tagged.Tagged "UTF-8" ByteString.ByteString)
-
 -- LazyText

 -- | Uses 'LazyText.toStrict'.
 instance From.From LazyText.Text Text.Text where
  from = LazyText.toStrict

-- | Uses 'LazyText.encodeUtf8'.
-instance From.From LazyText.Text (Tagged.Tagged "UTF-8" LazyByteString.ByteString) where
-  from = From.from . LazyText.encodeUtf8
-
-- | Converts via 'LazyByteString.ByteString'.
-instance From.From LazyText.Text (Tagged.Tagged "UTF-8" ByteString.ByteString) where
-  from = fmap From.from . Utility.into @(Tagged.Tagged "UTF-8" LazyByteString.ByteString)
-
 -- String

 -- | Uses 'Text.pack'. Some 'Char' values cannot be represented in 'Text.Text'
@ -1151,14 +1099,6 @@ instance From.From String LazyText.Text where
 instance From.From LazyText.Text String where
  from = LazyText.unpack

-- | Converts via 'Text.Text'.
-instance From.From String (Tagged.Tagged "UTF-8" ByteString.ByteString) where
-  from = Utility.via @Text.Text
-
-- | Converts via 'LazyText.Text'.
-instance From.From String (Tagged.Tagged "UTF-8" LazyByteString.ByteString) where
-  from = Utility.via @LazyText.Text
-
 -- TryFromException

 -- | Uses @coerce@.
@ -1286,6 +1226,56 @@ instance From.From (Tagged.Tagged t a) a
 -- | Uses @coerce@. Essentially the same as 'Tagged.retag'.
 instance From.From (Tagged.Tagged t a) (Tagged.Tagged u a)

+-- UTF-8
+
+-- | Uses 'Text.decodeUtf8''.
+instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) Text.Text where
+  tryFrom = Utility.eitherTryFrom $ Text.decodeUtf8' . From.from
+
+-- | Converts via 'Text.Text'.
+instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) LazyText.Text where
+  tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @LazyText.Text) . Utility.tryInto @Text.Text
+
+-- | Converts via 'Text.Text'.
+instance TryFrom.TryFrom (Encoding.UTF_8 ByteString.ByteString) String where
+  tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @Text.Text
+
+-- | Uses 'LazyText.decodeUtf8''.
+instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) LazyText.Text where
+  tryFrom = Utility.eitherTryFrom $ LazyText.decodeUtf8' . From.from
+
+-- | Converts via 'LazyText.Text'.
+instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) Text.Text where
+  tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @Text.Text) . Utility.tryInto @LazyText.Text
+
+-- | Converts via 'LazyText.Text'.
+instance TryFrom.TryFrom (Encoding.UTF_8 LazyByteString.ByteString) String where
+  tryFrom = Utility.eitherTryFrom $ fmap (Utility.into @String) . Utility.tryInto @LazyText.Text
+
+-- | Uses 'Text.encodeUtf8'.
+instance From.From Text.Text (Encoding.UTF_8 ByteString.ByteString) where
+  from = From.from . Text.encodeUtf8
+
+-- | Converts via 'ByteString.ByteString'.
+instance From.From Text.Text (Encoding.UTF_8 LazyByteString.ByteString) where
+  from = fmap From.from . Utility.into @(Encoding.UTF_8 ByteString.ByteString)
+
+-- | Uses 'LazyText.encodeUtf8'.
+instance From.From LazyText.Text (Encoding.UTF_8 LazyByteString.ByteString) where
+  from = From.from . LazyText.encodeUtf8
+
+-- | Converts via 'LazyByteString.ByteString'.
+instance From.From LazyText.Text (Encoding.UTF_8 ByteString.ByteString) where
+  from = fmap From.from . Utility.into @(Encoding.UTF_8 LazyByteString.ByteString)
+
+-- | Converts via 'Text.Text'.
+instance From.From String (Encoding.UTF_8 ByteString.ByteString) where
+  from = Utility.via @Text.Text
+
+-- | Converts via 'LazyText.Text'.
+instance From.From String (Encoding.UTF_8 LazyByteString.ByteString) where
+  from = Utility.via @LazyText.Text
+
 --

 realFloatToRational ::
--- a/source/test-suite/Main.hs
+++ b/source/test-suite/Main.hs
@ -33,6 +33,7 @@ import qualified GHC.Stack as Stack
 import qualified Numeric.Natural as Natural
 import qualified Test.HUnit as HUnit
 import qualified Witch
+import qualified Witch.Encoding as Encoding

 main :: IO ()
 main = HUnit.runTestTTAndExit $ specToTest spec
@ -1800,27 +1801,6 @@ spec = describe "Witch" $ do
        f (ByteString.pack [0x00]) `shouldBe` ShortByteString.pack [0x00]
        f (ByteString.pack [0x0f, 0xf0]) `shouldBe` ShortByteString.pack [0x0f, 0xf0]

-    describe "TryFrom ByteString Text" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" ByteString.ByteString) @Text.Text
-      it "works" $ do
-        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "")
-        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (Text.pack "a")
-        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
-
-    describe "TryFrom ByteString LazyText" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" ByteString.ByteString) @LazyText.Text
-      it "works" $ do
-        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (LazyText.pack "")
-        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a")
-        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
-
-    describe "TryFrom ByteString String" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" ByteString.ByteString) @String
-      it "works" $ do
-        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just ""
-        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just "a"
-        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
-
    describe "From [Word8] LazyByteString" $ do
      let f = Witch.from @[Word.Word8] @LazyByteString.ByteString
      it "works" $ do
@ -1842,27 +1822,6 @@ spec = describe "Witch" $ do
        f (LazyByteString.pack [0x00]) `shouldBe` ByteString.pack [0x00]
        f (LazyByteString.pack [0x0f, 0xf0]) `shouldBe` ByteString.pack [0x0f, 0xf0]

-    describe "TryFrom LazyByteString LazyText" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" LazyByteString.ByteString) @LazyText.Text
-      it "works" $ do
-        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (LazyText.pack "")
-        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a")
-        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
-
-    describe "TryFrom LazyByteString Text" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" LazyByteString.ByteString) @Text.Text
-      it "works" $ do
-        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (Text.pack "")
-        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (Text.pack "a")
-        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
-
-    describe "TryFrom LazyByteString String" $ do
-      let f = hush . Witch.tryFrom @(Tagged.Tagged "UTF-8" LazyByteString.ByteString) @String
-      it "works" $ do
-        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just ""
-        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just "a"
-        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
-
    describe "From [Word8] ShortByteString" $ do
      let f = Witch.from @[Word.Word8] @ShortByteString.ShortByteString
      it "works" $ do
@ -1891,18 +1850,6 @@ spec = describe "Witch" $ do
        f (Text.pack "a") `shouldBe` LazyText.pack "a"
        f (Text.pack "ab") `shouldBe` LazyText.pack "ab"

-    describe "From Text ByteString" $ do
-      let f = Witch.from @Text.Text @(Tagged.Tagged "UTF-8" ByteString.ByteString)
-      it "works" $ do
-        f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack [])
-        f (Text.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
-
-    describe "From Text LazyByteString" $ do
-      let f = Witch.from @Text.Text @(Tagged.Tagged "UTF-8" LazyByteString.ByteString)
-      it "works" $ do
-        f (Text.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack [])
-        f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
-
    describe "From LazyText Text" $ do
      let f = Witch.from @LazyText.Text @Text.Text
      it "works" $ do
@ -1910,18 +1857,6 @@ spec = describe "Witch" $ do
        f (LazyText.pack "a") `shouldBe` Text.pack "a"
        f (LazyText.pack "ab") `shouldBe` Text.pack "ab"

-    describe "From LazyText LazyByteString" $ do
-      let f = Witch.from @LazyText.Text @(Tagged.Tagged "UTF-8" LazyByteString.ByteString)
-      it "works" $ do
-        f (LazyText.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack [])
-        f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
-
-    describe "From LazyText ByteString" $ do
-      let f = Witch.from @LazyText.Text @(Tagged.Tagged "UTF-8" ByteString.ByteString)
-      it "works" $ do
-        f (LazyText.pack "") `shouldBe` Tagged.Tagged (ByteString.pack [])
-        f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
-
    describe "From String Text" $ do
      let f = Witch.from @String @Text.Text
      it "works" $ do
@ -1950,18 +1885,6 @@ spec = describe "Witch" $ do
        f (LazyText.pack "a") `shouldBe` "a"
        f (LazyText.pack "ab") `shouldBe` "ab"

-    describe "From String ByteString" $ do
-      let f = Witch.from @String @(Tagged.Tagged "UTF-8" ByteString.ByteString)
-      it "works" $ do
-        f "" `shouldBe` Tagged.Tagged (ByteString.pack [])
-        f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
-
-    describe "From String LazyByteString" $ do
-      let f = Witch.from @String @(Tagged.Tagged "UTF-8" LazyByteString.ByteString)
-      it "works" $ do
-        f "" `shouldBe` Tagged.Tagged (LazyByteString.pack [])
-        f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
-
    describe "From Integer Day" $ do
      let f = Witch.from @Integer @Time.Day
      it "works" $ do
@ -2087,6 +2010,92 @@ spec = describe "Witch" $ do
      it "works" $ do
        f (Tagged.Tagged False) `shouldBe` Tagged.Tagged False

+    describe "TryFrom (UTF_8 ByteString) Text" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @Text.Text
+      it "works" $ do
+        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (Text.pack "")
+        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (Text.pack "a")
+        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
+        f (Tagged.Tagged (ByteString.pack [0x24])) `shouldBe` Just (Text.pack "\x24")
+        f (Tagged.Tagged (ByteString.pack [0xc2, 0xa3])) `shouldBe` Just (Text.pack "\xa3")
+        f (Tagged.Tagged (ByteString.pack [0xe2, 0x82, 0xac])) `shouldBe` Just (Text.pack "\x20ac")
+        f (Tagged.Tagged (ByteString.pack [0xf0, 0x90, 0x8d, 0x88])) `shouldBe` Just (Text.pack "\x10348")
+
+    describe "TryFrom (UTF_8 ByteString) LazyText" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @LazyText.Text
+      it "works" $ do
+        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just (LazyText.pack "")
+        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a")
+        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
+
+    describe "TryFrom (UTF_8 ByteString) String" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 ByteString.ByteString) @String
+      it "works" $ do
+        f (Tagged.Tagged (ByteString.pack [])) `shouldBe` Just ""
+        f (Tagged.Tagged (ByteString.pack [0x61])) `shouldBe` Just "a"
+        f (Tagged.Tagged (ByteString.pack [0xff])) `shouldBe` Nothing
+
+    describe "TryFrom (UTF_8 LazyByteString) LazyText" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @LazyText.Text
+      it "works" $ do
+        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (LazyText.pack "")
+        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (LazyText.pack "a")
+        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
+
+    describe "TryFrom (UTF_8 LazyByteString) Text" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @Text.Text
+      it "works" $ do
+        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just (Text.pack "")
+        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just (Text.pack "a")
+        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
+
+    describe "TryFrom (UTF_8 LazyByteString) String" $ do
+      let f = hush . Witch.tryFrom @(Encoding.UTF_8 LazyByteString.ByteString) @String
+      it "works" $ do
+        f (Tagged.Tagged (LazyByteString.pack [])) `shouldBe` Just ""
+        f (Tagged.Tagged (LazyByteString.pack [0x61])) `shouldBe` Just "a"
+        f (Tagged.Tagged (LazyByteString.pack [0xff])) `shouldBe` Nothing
+
+    describe "From Text (UTF_8 ByteString)" $ do
+      let f = Witch.from @Text.Text @(Encoding.UTF_8 ByteString.ByteString)
+      it "works" $ do
+        f (Text.pack "") `shouldBe` Tagged.Tagged (ByteString.pack [])
+        f (Text.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
+        f (Text.pack "\x24") `shouldBe` Tagged.Tagged (ByteString.pack [0x24])
+        f (Text.pack "\xa3") `shouldBe` Tagged.Tagged (ByteString.pack [0xc2, 0xa3])
+        f (Text.pack "\x20ac") `shouldBe` Tagged.Tagged (ByteString.pack [0xe2, 0x82, 0xac])
+        f (Text.pack "\x10348") `shouldBe` Tagged.Tagged (ByteString.pack [0xf0, 0x90, 0x8d, 0x88])
+
+    describe "From Text (UTF_8 LazyByteString)" $ do
+      let f = Witch.from @Text.Text @(Encoding.UTF_8 LazyByteString.ByteString)
+      it "works" $ do
+        f (Text.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack [])
+        f (Text.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
+
+    describe "From LazyText (UTF_8 LazyByteString)" $ do
+      let f = Witch.from @LazyText.Text @(Encoding.UTF_8 LazyByteString.ByteString)
+      it "works" $ do
+        f (LazyText.pack "") `shouldBe` Tagged.Tagged (LazyByteString.pack [])
+        f (LazyText.pack "a") `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
+
+    describe "From LazyText (UTF_8 ByteString)" $ do
+      let f = Witch.from @LazyText.Text @(Encoding.UTF_8 ByteString.ByteString)
+      it "works" $ do
+        f (LazyText.pack "") `shouldBe` Tagged.Tagged (ByteString.pack [])
+        f (LazyText.pack "a") `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
+
+    describe "From String (UTF_8 ByteString)" $ do
+      let f = Witch.from @String @(Encoding.UTF_8 ByteString.ByteString)
+      it "works" $ do
+        f "" `shouldBe` Tagged.Tagged (ByteString.pack [])
+        f "a" `shouldBe` Tagged.Tagged (ByteString.pack [0x61])
+
+    describe "From String (UTF_8 LazyByteString)" $ do
+      let f = Witch.from @String @(Encoding.UTF_8 LazyByteString.ByteString)
+      it "works" $ do
+        f "" `shouldBe` Tagged.Tagged (LazyByteString.pack [])
+        f "a" `shouldBe` Tagged.Tagged (LazyByteString.pack [0x61])
+
 newtype Age
  = Age Int.Int8
  deriving (Eq, Show)
--- a/witch.cabal
+++ b/witch.cabal
@ -76,6 +76,7 @@ library
    , template-haskell >= 2.12 && < 2.20
  exposed-modules:
    Witch
+    Witch.Encoding
    Witch.From
    Witch.Instances
    Witch.Lift