named-text 1.1.0.0 → 1.1.1.0

raw patch · 4 files changed

+319/−3 lines, 4 filesdep +aesondep +bytestringdep +unordered-containersPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, bytestring, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Data/Name/JSON.hs +86/−0
• named-text.cabal +17/−1
• test/Test.hs +209/−2

@@ -1,5 +1,12 @@ # Revision history for named-text +## 1.1.1.0 -- 2022-12-28++* Added optional Data.Name.JSON providing `JSONSchema` with Aeson `ToJSON` and+  `FromJSON` instances.+* Additional tests.+* Added README and updated nix flake.+ ## 1.1.0.0 -- 2022-12-28  * Added tests and enhanced haddock.

@@ -0,0 +1,86 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-|++This module provides a 'JSONStyle' Named style that can be used for JSON+encoding/decoding.  It also provides conversion to and from that style from the+regular 'UTF8' style, as well as an "aeson" 'ToJSON' and 'FromJSON' instance.++-}++module Data.Name.JSON where++import Data.Aeson+import Data.Aeson.Types+import Data.Functor.Contravariant ( (>$<) )+import Data.Name+import Data.String ( IsString(fromString) )+++-- | The JSONStyle of Named objects can be directly transformed to and from JSON+-- (via Aeson's ToJSON and FromJSON classes).  The Named nameOf is not+-- represented in the JSON form; field names are expected to be provided by the+-- Named field name itself.  Bi-directional conversions between the JSON style+-- and the UTF8 style is automatic.++type JSONStyle = "JSON" :: NameStyle++instance NameText JSONStyle++instance ConvertNameStyle JSONStyle UTF8 nameOf+instance ConvertNameStyle UTF8 JSONStyle nameOf++instance ConvertNameStyle JSONStyle CaseInsensitive nameOf+instance ConvertNameStyle CaseInsensitive JSONStyle nameOf+++-- -- The generic instance results in an object: { "name": "..." } This+-- -- instance declaration avoids that and causes the JSON form to be a simple+-- -- string.  Currently there's no FromJSON, although it's likely the generic+-- -- instance would successfully work under OverloadedStrings+instance ToJSON (Named JSONStyle nameTy) where+  toJSON = toJSON . nameText++instance ToJSONKey (Named JSONStyle nameTy) where+  toJSONKey = toJSONKeyText nameText++instance FromJSON (Named JSONStyle nameTy) where+  parseJSON j = fromString <$> parseJSON j++instance FromJSONKey (Named JSONStyle nameTy) where+  fromJSONKey = FromJSONKeyText fromText+++instance ToJSON (Name nameTy) where+  toJSON = toJSON . convertStyle @UTF8 @JSONStyle++instance ToJSONKey (Name nameTy) where+  toJSONKey = convertStyle @UTF8 @JSONStyle >$< toJSONKey++instance FromJSON (Name nameTy) where+  parseJSON j = convertStyle @JSONStyle @UTF8 . fromString <$> parseJSON j++instance FromJSONKey (Name nameTy) where+  fromJSONKey = convertStyle @JSONStyle @UTF8 <$> fromJSONKey+++instance ToJSON (Named CaseInsensitive nameTy) where+  toJSON = toJSON . convertStyle @CaseInsensitive @JSONStyle++instance ToJSONKey (Named CaseInsensitive nameTy) where+  toJSONKey = convertStyle @CaseInsensitive @JSONStyle >$< toJSONKey++instance FromJSON (Named CaseInsensitive nameTy) where+  parseJSON j = convertStyle @JSONStyle @CaseInsensitive . fromString <$> parseJSON j++instance FromJSONKey (Named CaseInsensitive nameTy) where+  fromJSONKey = convertStyle @JSONStyle @CaseInsensitive <$> fromJSONKey

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               named-text-version:            1.1.0.0+version:            1.1.1.0 synopsis:           A parameterized named text type and associated functionality. description:   .@@ -34,6 +34,15 @@   type: git   location: https://github.com/kquick/named-text ++flag with-json+  description: Build optional Data.Text.JSON module with JSON Named style support+  default: True+  manual: False+  -- This flag allows using named-text without the additional dependencies+  -- introduced by aeson when JSON translation is not needed.++ common bldspec   ghc-options:  -Wall                 -Wcompat@@ -56,6 +65,9 @@                     , sayable >= 1.0 && < 1.1                     , text     exposed-modules:  Data.Name+    if flag(with-json)+      build-depends: aeson >= 1.5 && < 2.2+      exposed-modules: Data.Name.JSON   test-suite namedTests@@ -75,3 +87,7 @@                     , tasty-checklist >= 1.0 && < 1.1                     , tasty-hspec >= 1.2 && < 1.3                     , text+                    , unordered-containers+    if flag(with-json)+      build-depends: aeson >= 1.5 && < 2.2+                   , bytestring

@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -10,6 +14,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} +import qualified Data.HashMap.Strict as Map import           Data.Name import           Data.Parameterized.Context ( pattern Empty, pattern (:>) ) import           Data.Proxy ( Proxy(Proxy) )@@ -17,6 +22,7 @@ import           Data.Text ( Text ) import qualified Data.Text as T import           GHC.Exts ( proxy#, IsList(fromList, toList) )+import           GHC.Generics ( Generic ) import qualified Prettyprinter as PP import           Text.Sayable @@ -26,7 +32,13 @@ import           Test.Tasty.Hspec import           Test.Tasty.Runners.AntXML +#ifdef VERSION_aeson+import           Data.Aeson+import           Data.ByteString.Lazy ( ByteString )+import           Data.Name.JSON+#endif + main :: IO () main = tests >>= defaultMainWithIngredients (antXMLRunner : defaultIngredients) @@ -42,6 +54,9 @@         , testSomeNames         , testHasName         , testUtilities+#ifdef VERSION_aeson+        , testJSON+#endif         ]  @@ -296,6 +311,8 @@        :> Val "matches implicit construction" id "list of text"        :> Val "as sayable" (sez @"test") "CR40-2 'list of text'"        :> Val "as extracted text" nameText "list of text"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR40-2"+       :> Val "style proxy" styleProxy (Proxy :: Proxy UTF8)       )      it "CR41 UTF8 explicit conversion" $@@ -306,6 +323,8 @@        :> Val "matches implicit construction" id "mjtu!pg!ufyu"        :> Val "as sayable" (sez @"test") "CR41-3 'mjtu!pg!ufyu'"        :> Val "as extracted text" nameText "mjtu!pg!ufyu"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR41-3"+       :> Val "style proxy" styleProxy (Proxy :: Proxy UTF8)       )      it "CR42 CaseInsensitive conversion" $@@ -317,6 +336,8 @@        :> Val "matches implicit construction" id "bit of text"        :> Val "as sayable" (sez @"test") "CR42 new «bit of text»"        :> Val "as extracted text" nameText "bit of text"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR42 new"+       :> Val "style proxy" styleProxy (Proxy :: Proxy CaseInsensitive)       )      it "CR43 Secure conversion" $@@ -329,6 +350,8 @@        :> Val "as sayable" (sez @"test") "CR43 again 'hi#######xt'"        :> Val "as extracted text" nameText "hi#######xt"        :> Val "security bypass extraction" secureNameBypass ("hidden text" :: Text)+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR43 again"+       :> Val "style proxy" styleProxy (Proxy :: Proxy Secure)       )    describe "Named style conversions" $ do@@ -343,6 +366,8 @@        :> Val "matches implicit construction" id "some text"        :> Val "as sayable" (sez @"test") "CR44 «some text»"        :> Val "as extracted text" nameText "some text"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR44"+       :> Val "style proxy" styleProxy (Proxy :: Proxy CaseInsensitive)       )      it "CR45 UTF8->Secure default conversion" $@@ -353,6 +378,8 @@        :> Val "matches implicit construction" id "Some TEXT"        :> Val "as sayable" (sez @"test") "CR45 'So#####XT'"        :> Val "as extracted text" nameText "So#####XT"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR45"+       :> Val "style proxy" styleProxy (Proxy :: Proxy Secure)       )      it "CR46 CaseInsensitive->UTF8 default conversion" $@@ -364,6 +391,8 @@        :> Val "matches implicit construction" id "some text"        :> Val "as sayable" (sez @"test") "CR46 'some text'"        :> Val "as extracted text" nameText "some text"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR46"+       :> Val "style proxy" styleProxy (Proxy :: Proxy UTF8)       )      it "CR47 Secure->UTF8 default conversion" $@@ -375,6 +404,8 @@        :> Val "matches implicit construction" id "So#####XT"        :> Val "as sayable" (sez @"test") "CR47 'So#####XT'"        :> Val "as extracted text" nameText "So#####XT"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR47"+       :> Val "style proxy" styleProxy (Proxy :: Proxy UTF8)       )      it "CR48 Secure->UTF8 implicit bypass conversion" $@@ -386,6 +417,8 @@        :> Val "matches implicit construction" id "Some TEXT"        :> Val "as sayable" (sez @"test") "CR48 'Some TEXT'"        :> Val "as extracted text" nameText "Some TEXT"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR48"+       :> Val "style proxy" styleProxy (Proxy :: Proxy UTF8)       )  instance ConvertName UTF8 "CR40" "CR40-2"@@ -473,17 +506,21 @@   describe "HasName Foo" $ do      it "CR70 can extract UTF8 myName from Foo" $-      myName (Foo "bar" "baz" "quux") `shouldBe` ("baz" :: Name "principle")+      myName (Foo "bar" "baz" (Map.fromList [("one","quux"), ("two","brox")]))+      `shouldBe` ("baz" :: Name "principle")      it "CR71 can extract secure myName from Bar" $       myName (Bar "baz" "quux") `shouldBe` ("quux" :: Named Secure "second") -data Foo = Foo (Name "prefix") (Name "principle") (Name "alt")+data Foo = Foo (Name "prefix") (Name "principle")+               (Map.HashMap (Name "alt-key") (Name "alt"))+         deriving (Eq, Generic, Show) instance HasName Foo UTF8 "principle" where myName (Foo _ p _) = p  data Bar = Bar (Name "first") (Named Secure "second") instance HasName Bar Secure "second" where myName (Bar _ s) = s +instance TestShow Foo  testUtilities :: IO TestTree testUtilities = testSpec "Named utilities" $ do@@ -517,3 +554,173 @@      it "CR88 can check a non-null Secure named" $       nullName ("Not empty" :: Named Secure "CR88") `shouldBe` False++----------------------------------------------------------------------+-- Data.Name.JSON++#ifdef VERSION_aeson++instance TestShow (Proxy JSONStyle) where testShow _ = "Proxy :: \"JSONStyle\""++testJSON :: IO TestTree+testJSON = testSpec "Named JSON style" $ do+  describe "Named JSON" $ do++    it "CR90 can create a JSON Named from Text" $+      withChecklist "CR90" $+      fromText @(Named JSONStyle "CR90") ("test JSON text" :: Text)+      `checkValues`+      (Empty+       :> Val "overloaded equivalent text value" id "test JSON text"+       :> Got "case sensitive text value" (/= "Test json Text")+       :> Val "name parameter value" (\n -> nameOf n proxy#) "CR90"+       :> Val "style proxy" styleProxy (Proxy :: Proxy JSONStyle)+       :> Val "extracted text" nameText ("test JSON text" :: Text)+      )++    it "CR91 render UTF8 via Sayable" $+      withChecklist "CR91" $+      ("test JSON thing" :: Named JSONStyle "CR91")+      `checkValues`+      (Empty+       :> Val "as sayable" (sez @"test") "CR91 'test JSON thing'"+       :> Val "as sayable info" (sez @"info") "test JSON thing"+      )++    it "CR92 render UTF8 via Prettyprinter" $+      withChecklist "CR92" $+      fromText @(Named JSONStyle "CR92") ("test of JSON text" :: Text)+      `checkValues`+      (Empty+       :> Val "as pretty" (show . PP.pretty) "CR92 'test of JSON text'"+      )++    it "CR93 render UTF8 via Show" $+      withChecklist "CR93" $+      fromText @(Named JSONStyle "CR93") ("test of text" :: Text)+      `checkValues`+      (Empty+       :> Val "as show" show "CR93 'test of text'"+      )++    it "CR94 JSON semigroup" $+      withChecklist "CR94" $+      (fromText @(Named JSONStyle "CR94") ("more test JSON text" :: Text) <> "!!")+      `checkValues`+      (Empty+       :> Val "raw value" id "more test JSON text!!"+       :> Val "as sayable" (sez @"test") "CR94 'more test JSON text!!'"+      )++    it "CR95 JSON default conversion" $+      withChecklist "CR95" $+      (convertName (fromText "some JSON text" :: Named JSONStyle "CR95")+       :: Named JSONStyle "CR95 2")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "some JSON text"+       :> Val "as sayable" (sez @"test") "CR95 2 'some JSON text'"+       :> Val "as extracted text" nameText "some JSON text"+       :> Val "nameOf" (\n -> nameOf n proxy#) "CR95 2"+       :> Val "style proxy" styleProxy (Proxy :: Proxy JSONStyle)+      )++    it "CR96 UTF8->JSON default conversion" $+      withChecklist "CR96" $+      (convertStyle (fromText "Some JSON-able TEXT" :: Name "CR96")+        :: Named JSONStyle "CR96")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "Some JSON-able TEXT"+       :> Val "as sayable" (sez @"test") "CR96 'Some JSON-able TEXT'"+       :> Val "as extracted text" nameText "Some JSON-able TEXT"+      )++    it "CR97 JSON->UTF8 default conversion" $+      withChecklist "CR97" $+      (convertStyle (fromText "Some un-JSON-able TEXT" :: Named JSONStyle "CR97")+        :: Name "CR97")+      `checkValues`+      (Empty+       :> Val "matches implicit construction" id "Some un-JSON-able TEXT"+       :> Val "as sayable" (sez @"test") "CR97 'Some un-JSON-able TEXT'"+       :> Val "as extracted text" nameText "Some un-JSON-able TEXT"+      )++    it "CR98 can get a JSON length" $+      nameLength ("Length of JSON TEXT" :: Named JSONStyle "CR98") `shouldBe` 19++    it "CR99 can check a null JSON Named" $+      nullName ("" :: Named JSONStyle "CR99") `shouldBe` True++    it "CR100 can check a non-null JSON Named" $+      nullName ("*" :: Named JSONStyle "CR99") `shouldBe` False++    it "CR101 Named toJSON is valid" $+      withChecklist "CR101" $+      let obj = convertStyle ("Regular TEXT!" :: Name "CR101")+                :: Named JSONStyle "CR101"+      in encode (toJSON obj)+         `checkValues`+         (Empty+          :> Val "encoded" id "\"Regular TEXT!\""+          :> Val "decoded" decode (Just obj)+         )++    it "CR102 toJSON of structure containing Named is valid" $+      withChecklist "CR102" $+      let obj = Foo "start" "your engines"+                (Map.fromList [ ("one","ready")+                              , ("two", "set")+                              , ("three", "go")+                              ])+      in encode (toJSON obj)+         `checkValues`+         (Empty+          :> Val "encoded" id+          "[\"start\",\"your engines\",{\"one\":\"ready\",\"three\":\"go\",\"two\":\"set\"}]"+          :> Val "decoded" decode (Just obj)+         )++    it "CR103 toJSON of record containing Named is valid" $+      withChecklist "CR103" $+      let obj = Info "John Henry" "railroad worker" "hammer master"+      in encode (toJSON obj)+         `checkValues`+         (Empty+          :> Val "encoded" id+          "{\"desc\":\"hammer master\",\"name\":\"John Henry\",\"title\":\"railroad worker\"}"+          :> Val "decoded" decode (Just obj)+         )++    it "CR104 JSON of record containing CaseInsensitive Named is not necessarily round-robin" $+      withChecklist "CR104" $+      let obj = Info "John Henry" "Railroad Worker" "Hammer Master"+      in encode (toJSON obj)+         `checkValues`+         (Empty+          :> Val "encoded" id+          "{\"desc\":\"Hammer Master\",\"name\":\"John Henry\",\"title\":\"railroad worker\"}"+          :> Val "decoded" decode (Just $ obj { title = fromText $ T.toLower $ nameText $ title obj })+         )++data Info = Info { name :: Name "name"+                 , title :: Named CaseInsensitive "title"+                 , desc :: Name "description"+                 }+  deriving (Eq, Generic, Show)+instance ToJSON Info+instance FromJSON Info++instance ToJSON Foo+instance FromJSON Foo++instance ConvertName JSONStyle "CR95" "CR95 2"++instance TestShow ByteString+instance TestShow a => TestShow (Maybe a) where+  testShow = \case+    Nothing -> "NOTHING"+    Just a -> "JUST " <> testShow a+instance TestShow Info+#endif