diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog +## [0.3.0.1] - 2024-01-03 + +- Add support for GHC 9.6 +- Fix bug in `mkNullableNonEmptyText` that incorrectly counted leading and trailing whitespace against the character limit. +- Improve documentation for `NullableNonEmptyText` + ## [0.3.0.0] - 2023-10-24 - Remove incorrect `Semigroup` instance for `NonEmptyText` diff --git a/src/Data/StringVariants/NonEmptyText/Internal.hs b/src/Data/StringVariants/NonEmptyText/Internal.hs --- a/src/Data/StringVariants/NonEmptyText/Internal.hs +++ b/src/Data/StringVariants/NonEmptyText/Internal.hs @@ -77,8 +77,8 @@ instance TypeError ( 'Text "An instance of 'Semigroup (NonEmptyText n)' would violate the " - ':<>: 'Text "length guarantees." - ':$$: 'Text "Please use '(<>|)' or 'concatWithSpace' to combine the values." + ' :<>: 'Text "length guarantees." + ' :$$: 'Text "Please use '(<>|)' or 'concatWithSpace' to combine the values." ) => Semigroup (NonEmptyText n) where (<>) = error "unreachable" diff --git a/src/Data/StringVariants/NullableNonEmptyText.hs b/src/Data/StringVariants/NullableNonEmptyText.hs --- a/src/Data/StringVariants/NullableNonEmptyText.hs +++ b/src/Data/StringVariants/NullableNonEmptyText.hs @@ -50,24 +50,45 @@ -- | Newtype wrapper around Maybe NonEmptyText that converts empty string to 'Nothing'. -- --- This is aimed primarily at JSON parsing: make it possible to parse empty --- string and turn it into @Nothing@, in order to convert everything into --- @Maybe NonEmptyText@ at the edge of the system. +-- @'NullableNonEmptyText' n@ is used in API types to represent optional text fields when you do not want an empty string to fail to parse. +-- Like 'NonEmptyText', the payload 'Text' is guaranteed to be non-empty, within the character limit, and stripped of whitespace. +-- Unlike 'NonEmptyText', it will successfully parse empty strings as 'nullNonEmptyText'. -- --- While using this for JSON parsing, use @Maybe NullableNonEmptyText@. Aeson --- special-cases @Maybe@ to allow nulls, so @Maybe@ catches the nulls and --- @NullableNonEmptyText@ catches the empty strings. +-- Since Aeson version 2.2, fields of this type maybe be missing, @null@, or empty without failing to parse. +-- Avoid using @Maybe (NullableNonEmptyText n)@ in API types, since it creates unnecessary edge cases that complicate the code. -- --- To extract @Maybe NonEmptyText@ values from @Maybe NullableNonEmptyText@, --- use 'nullableNonEmptyTextToMaybeNonEmptyText'. +-- __NB:__ When using a version of Aeson prior to 2.2, you /must/ use @Maybe (NullableNonEmptyText n)@ if you want to allow missing or null fields to parse. +-- +-- @ +-- data Person = Person +-- { name :: 'NonEmptyText' 50 +-- , catchphrase :: 'NullableNonEmptyText' 500 +-- } +-- @ +-- +-- With this type definition, these four JSON objects below are valid and parse as @Person "Daniel" nullNonEmptyText@. +-- +-- > {"name": "Daniel"} +-- > {"name": "Daniel", catchphrase: null} +-- > {"name": "Daniel", catchphrase: ""} +-- > {"name": "Daniel", catchphrase: " "} +-- +-- These two JSON objects parses as @Person "Daniel" (mkNullableNonEmptyText "Yabba-Dabba Do!")@ +-- +-- > {"name": "Daniel", catchphrase: "Yabba-Dabba Do!"} +-- > {"name": "Daniel", catchphrase: " Yabba-Dabba Do! "} +-- +-- Use 'nullableNonEmptyTextToMaybeNonEmptyText' to extract @Maybe (NonEmptyText n)@ from @NullableNonEmptyText n@. newtype NullableNonEmptyText n = NullableNonEmptyText (Maybe (NonEmptyText n)) deriving stock (Generic, Show, Read, Lift) deriving newtype (Eq) mkNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NullableNonEmptyText n) mkNullableNonEmptyText t - | T.compareLength t (fromIntegral $ natVal (Proxy @n)) == GT = Nothing -- we can't store text that is too long + | T.compareLength stripped (fromIntegral $ natVal (Proxy @n)) == GT = Nothing -- we can't store text that is too long | otherwise = Just $ NullableNonEmptyText $ mkNonEmptyText t + where + stripped = T.filter (/= '\NUL') $ T.strip t nullNonEmptyText :: NullableNonEmptyText n nullNonEmptyText = NullableNonEmptyText Nothing diff --git a/src/Data/StringVariants/Util.hs b/src/Data/StringVariants/Util.hs --- a/src/Data/StringVariants/Util.hs +++ b/src/Data/StringVariants/Util.hs @@ -66,4 +66,4 @@ type family SymbolNoLongerThan (s :: Symbol) (n :: Nat) :: Constraint where SymbolNoLongerThan s n = If (SymbolLength 0 (UnconsSymbol s) <=? n) (() :: Constraint) - (TypeError ('Text "Invalid NonEmptyText. Needs to be <= " ':<>: 'ShowType n ':<>: 'Text " characters. Has " ':<>: 'ShowType (SymbolLength 0 (UnconsSymbol s)) ':<>: 'Text " characters.")) + (TypeError ('Text "Invalid NonEmptyText. Needs to be <= " ' :<>: 'ShowType n ' :<>: 'Text " characters. Has " ' :<>: 'ShowType (SymbolLength 0 (UnconsSymbol s)) ' :<>: 'Text " characters.")) diff --git a/string-variants.cabal b/string-variants.cabal --- a/string-variants.cabal +++ b/string-variants.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: string-variants -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Constrained text newtypes description: See README at . category: Data @@ -16,7 +16,7 @@ license-file: LICENSE build-type: Simple tested-with: - GHC ==9.2.4 || ==9.4.2 + GHC ==9.2.8 || ==9.4.8 || ==9.6.3 extra-source-files: CHANGELOG.md @@ -81,7 +81,6 @@ , bytestring , mono-traversable , refined - , refinery , string-conversions , template-haskell , text @@ -92,6 +91,7 @@ main-is: Main.hs other-modules: Spec + Specs.JsonEncodingSpec Specs.NonEmptySpec Specs.TextManipulationSpec Paths_string_variants @@ -138,19 +138,11 @@ hspec-discover:hspec-discover build-depends: HUnit - , QuickCheck , aeson >=2.0.0.0 , base >=4.16 && <5 - , bytestring , hedgehog , hspec - , hspec-core - , hspec-expectations , hspec-hedgehog - , mono-traversable - , refined - , refinery - , string-conversions , string-variants , template-haskell , text diff --git a/test/Specs/JsonEncodingSpec.hs b/test/Specs/JsonEncodingSpec.hs new file mode 100644 --- /dev/null +++ b/test/Specs/JsonEncodingSpec.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE CPP #-} + +module Specs.JsonEncodingSpec (spec) where + +import Data.Aeson +import Data.StringVariants.NonEmptyText +import Data.StringVariants.NonEmptyText.Internal +import Data.StringVariants.NullableNonEmptyText +import GHC.Generics +import Prelude +import Test.Hspec + +data Person = Person {name :: NonEmptyText 6, catchphrase :: NullableNonEmptyText 15} + deriving stock (Eq, Generic, Show) + deriving anyclass (FromJSON, ToJSON) + +spec :: Spec +spec = describe "FromJSON instances" $ do + describe "NonEmptyText" $ do + it "rejects strings that are too long" $ + assertParseFailure $ + object ["name" .= replicate 7 'a', "catchphrase" .= String "Yabba-Dabba Do!"] + it "rejects missing properties" $ + assertParseFailure $ + object ["catchphrase" .= String "Yabba-Dabba Do!"] + it "rejects null properties" $ + assertParseFailure $ + object ["name" .= Null, "catchphrase" .= String "Yabba-Dabba Do!"] + it "rejects empty strings" $ + assertParseFailure $ + object ["name" .= String "", "catchphrase" .= String "Yabba-Dabba Do!"] + it "rejects whitespace strings" $ + assertParseFailure $ + object ["name" .= String " ", "catchphrase" .= String "Yabba-Dabba Do!"] + it "strips whitespace" $ + object ["name" .= String " Daniel ", "catchphrase" .= String "Yabba-Dabba Do!"] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText $ Just $ NonEmptyText "Yabba-Dabba Do!") + describe "NullableNonEmptyText" $ do + it "rejects strings that are too long" $ + assertParseFailure $ + object ["name" .= String "Daniel", "catchphrase" .= replicate 16 'a'] +#if MIN_VERSION_aeson(2,2,0) + it "accepts missing properties" $ + object ["name" .= String "Daniel"] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText Nothing) + it "accepts null properties" $ + object ["name" .= String "Daniel", "catchphrase" .= Null] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText Nothing) +#endif + it "accepts empty strings" $ + object ["name" .= String "Daniel", "catchphrase" .= String ""] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText Nothing) + it "accepts whitespace strings" $ + object ["name" .= String "Daniel", "catchphrase" .= String " "] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText Nothing) + it "strips whitespace" $ + object ["name" .= String "Daniel", "catchphrase" .= String " Yabba-Dabba Do! "] + `shouldParseAs` + Person (NonEmptyText "Daniel") (NullableNonEmptyText $ Just $ NonEmptyText "Yabba-Dabba Do!") + where + assertParseFailure :: HasCallStack => Value -> IO () + assertParseFailure val = + decode @Person (encode val) `shouldBe` Nothing + + shouldParseAs :: HasCallStack => Value -> Person -> IO () + shouldParseAs val person = + decode (encode val) `shouldBe` Just person diff --git a/test/Specs/NonEmptySpec.hs b/test/Specs/NonEmptySpec.hs --- a/test/Specs/NonEmptySpec.hs +++ b/test/Specs/NonEmptySpec.hs @@ -103,3 +103,13 @@ usePositiveNat n (pure ()) $ \(_ :: proxy n) -> do let mtext = mkNonEmptyTextWithTruncate @n (T.pack $ replicate (n' + 1) 'x') (T.length . nonEmptyTextToText <$> mtext) === Just n' + + describe "mkNullableNonEmptyText" $ do + it "should reject strings that are too big" $ + mkNullableNonEmptyText @2 "hey" `shouldBe` Nothing + it "should accept empty strings" $ + mkNullableNonEmptyText @2 "" `shouldBe` Just (NullableNonEmptyText Nothing) + it "should accept whitespace strings" $ + mkNullableNonEmptyText @2 " " `shouldBe` Just (NullableNonEmptyText Nothing) + it "should strip whitespace" $ + mkNullableNonEmptyText @2 " hi " `shouldBe` Just (NullableNonEmptyText $ Just $ unsafeMkNonEmptyText "hi")