From 598048d92b8d6a1aaa4c0fe2b41e650fad476a23 Mon Sep 17 00:00:00 2001 From: "Daniel P. Brice" Date: Thu, 4 Jan 2024 12:04:31 -0800 Subject: [PATCH] Version 0.3.0.1 * 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` --- .github/workflows/haskell-ci.yml | 26 +++---- CHANGELOG.md | 6 ++ cabal.haskell-ci | 10 --- cabal.project | 7 +- package.yaml | 18 +++-- .../StringVariants/NullableNonEmptyText.hs | 39 +++++++--- string-variants.cabal | 16 ++--- test/Specs/JsonEncodingSpec.hs | 72 +++++++++++++++++++ test/Specs/NonEmptySpec.hs | 10 +++ 9 files changed, 150 insertions(+), 54 deletions(-) delete mode 100644 cabal.haskell-ci create mode 100644 test/Specs/JsonEncodingSpec.hs diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 7803f95..1d514f9 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -19,7 +19,7 @@ on: jobs: linux: name: Haskell-CI - Linux - ${{ matrix.compiler }} - runs-on: ubuntu-20.04 + runs-on: ubuntu-22.04 timeout-minutes: 60 container: @@ -28,14 +28,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.2 + - compiler: ghc-9.2.8 compilerKind: ghc - compilerVersion: 9.4.2 + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.4 + - compiler: ghc-9.4.8 compilerKind: ghc - compilerVersion: 9.2.4 + compilerVersion: 9.4.8 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.6.3 + compilerKind: ghc + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: false fail-fast: false @@ -146,13 +151,10 @@ jobs: touch cabal.project.local echo "packages: ${PKGDIR_string_variants}" >> cabal.project echo "package string-variants" >> cabal.project - echo " ghc-options: -Werror=missing-methods" >> cabal.project - cat >> cabal.project <> cabal.project + echo "tests: True" >> cabal.project + echo "allow-newer:" >> cabal.project + echo " refined:aeson" >> cabal.project $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(string-variants)$/; }' >> cabal.project.local cat cabal.project cat cabal.project.local diff --git a/CHANGELOG.md b/CHANGELOG.md index 26534f9..8d9b158 100644 --- 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/cabal.haskell-ci b/cabal.haskell-ci deleted file mode 100644 index 094878a..0000000 --- a/cabal.haskell-ci +++ /dev/null @@ -1,10 +0,0 @@ --- HI! If you add something in here, make sure to copy it to cabal.project if --- needed! -raw-project - -- https://github.com/nikita-volkov/refined/pull/86 - -- this was merged, just need to wait for >0.7 to have a release - source-repository-package - type: git - location: https://github.com/nikita-volkov/refined - tag: eced2bb0991bde971646e4b3d291870d0aab83a3 - --sha256: sha256-QvZSFeAmgdBwdyneGRKMCMNGnP+8rD/uTED0icQB+4s= diff --git a/cabal.project b/cabal.project index 74dd83c..514478e 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,8 @@ -- HI! for pants reasons, if you add anything load bearing in here, you have to --- add it to raw-project in cabal.haskell-ci +-- add it to `generate cabal.project` in `.github/workflows/haskell-ci.yml` packages: . + +tests: True + +allow-newer: + refined:aeson diff --git a/package.yaml b/package.yaml index 3223468..c62aead 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: string-variants -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Constrained text newtypes description: See README at . category: Data @@ -11,22 +11,22 @@ extra-source-files: license: MIT -tested-with: GHC ==9.2.4 || ==9.4.2 +tested-with: GHC ==9.2.8 || ==9.4.8 || ==9.6.3 # FIXME(jadel): maybe instances should be in a separate package but whatever dependencies: - aeson >= 2.0.0.0 - base >= 4.16 && <5 - - bytestring - - mono-traversable - - QuickCheck - - string-conversions - template-haskell - - refinery - - refined - text library: source-dirs: src + dependencies: + - QuickCheck + - bytestring + - mono-traversable + - refined + - string-conversions # Test suite tests: @@ -44,9 +44,7 @@ tests: - HUnit - hedgehog - hspec - - hspec-core - hspec-hedgehog - - hspec-expectations - string-variants build-tools: - hspec-discover diff --git a/src/Data/StringVariants/NullableNonEmptyText.hs b/src/Data/StringVariants/NullableNonEmptyText.hs index 5a66f43..f81a88a 100644 --- a/src/Data/StringVariants/NullableNonEmptyText.hs +++ b/src/Data/StringVariants/NullableNonEmptyText.hs @@ -50,24 +50,45 @@ import Prelude -- | 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/string-variants.cabal b/string-variants.cabal index cd27981..9f675d2 100644 --- 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: MIT 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 @@ library , bytestring , mono-traversable , refined - , refinery , string-conversions , template-haskell , text @@ -92,6 +91,7 @@ test-suite test main-is: Main.hs other-modules: Spec + Specs.JsonEncodingSpec Specs.NonEmptySpec Specs.TextManipulationSpec Paths_string_variants @@ -138,19 +138,11 @@ test-suite test 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 index 0000000..96492e2 --- /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 index 22b35fb..1d9f431 100644 --- a/test/Specs/NonEmptySpec.hs +++ b/test/Specs/NonEmptySpec.hs @@ -103,3 +103,13 @@ spec = describe "NonEmptyText variants" $ do 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")