diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,14 @@ # Changelog +## [0.3.0.0] - 2023-10-24 + +- Remove incorrect `Semigroup` instance for `NonEmptyText` + +## [0.2.2.1] - 2023-06-20 + +- Add support for `aeson-2.2.0.0`. +- When built with `aeson >=2.2.0.0`, record fields with type `NullableNonEmptyText` will be omittable. + ## [0.2.2.0] - 2023-02-10 - Add `proseFromNonEmptyText` to create `Prose` from `NonEmptyText`. diff --git a/src/Data/StringVariants/NonEmptyText.hs b/src/Data/StringVariants/NonEmptyText.hs --- a/src/Data/StringVariants/NonEmptyText.hs +++ b/src/Data/StringVariants/NonEmptyText.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} @@ -13,6 +14,7 @@ -- * Construction mkNonEmptyText, mkNonEmptyTextWithTruncate, + IsNonEmptyText, literalNonEmptyText, unsafeMkNonEmptyText, compileNonEmptyText, @@ -73,7 +75,15 @@ where errorMessage = fail $ "Invalid NonEmptyText. Needs to be < " ++ show (n + 1) ++ " characters, and not entirely whitespace: " ++ s -literalNonEmptyText :: forall (s :: Symbol) (n :: Nat). (KnownSymbol s, KnownNat n, SymbolNonEmpty s, SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) => NonEmptyText n +type IsNonEmptyText n s = + ( KnownSymbol s + , KnownNat n + , SymbolNonEmpty s + , SymbolWithNoSpaceAround s + , SymbolNoLongerThan s n + ) + +literalNonEmptyText :: forall (s :: Symbol) (n :: Nat). IsNonEmptyText n s => NonEmptyText n literalNonEmptyText = NonEmptyText (T.pack (symbolVal (Proxy @s))) convertEmptyTextToNothing :: Text -> Maybe Text 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 @@ -22,7 +22,7 @@ import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic) -import GHC.TypeLits (KnownNat, Nat, natVal, type (<=)) +import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (<=)) import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax (Lift (..), TyLit (..), Type (..)) import Test.QuickCheck @@ -31,7 +31,7 @@ -- | Non Empty Text, requires the input is between 1 and @n@ chars and not just whitespace. newtype NonEmptyText (n :: Nat) = NonEmptyText Text deriving stock (Generic, Show, Read, Lift) - deriving newtype (Eq, Ord, ToJSON, Semigroup, MonoFoldable) + deriving newtype (Eq, Ord, ToJSON, MonoFoldable) type instance Element (NonEmptyText _n) = Char @@ -73,6 +73,15 @@ -- Mostly alphanumeric characters, all human readable str <- replicateM size $ elements ['0' .. 'z'] pure $ T.pack str + +instance + TypeError + ( 'Text "An instance of 'Semigroup (NonEmptyText n)' would violate the " + ':<>: 'Text "length guarantees." + ':$$: 'Text "Please use '(<>|)' or 'concatWithSpace' to combine the values." + ) + => Semigroup (NonEmptyText n) where + (<>) = error "unreachable" mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) mkNonEmptyText t 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -9,6 +11,7 @@ -- * Constructing mkNonEmptyTextWithTruncate, compileNullableNonEmptyText, + IsNullableNonEmptyText, literalNullableNonEmptyText, mkNullableNonEmptyText, parseNullableNonEmptyText, @@ -59,7 +62,7 @@ -- use 'nullableNonEmptyTextToMaybeNonEmptyText'. newtype NullableNonEmptyText n = NullableNonEmptyText (Maybe (NonEmptyText n)) deriving stock (Generic, Show, Read, Lift) - deriving newtype (Eq, ToJSON) + deriving newtype (Eq) mkNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NullableNonEmptyText n) mkNullableNonEmptyText t @@ -72,6 +75,16 @@ isNullNonEmptyText :: NullableNonEmptyText n -> Bool isNullNonEmptyText = (== nullNonEmptyText) +instance ToJSON (NullableNonEmptyText n) where + toJSON (NullableNonEmptyText t) = toJSON t + + toEncoding (NullableNonEmptyText t) = toEncoding t + +#if MIN_VERSION_aeson(2,2,0) + omitField (NullableNonEmptyText Nothing) = True + omitField _ = False +#endif + instance (KnownNat n, 1 <= n) => FromJSON (NullableNonEmptyText n) where parseJSON = \case J.String t -> case mkNullableNonEmptyText t of @@ -80,6 +93,10 @@ J.Null -> pure $ NullableNonEmptyText Nothing x -> fail $ "Data/StringVariants/NullableNonEmptyText.hs: When trying to parse a NullableNonEmptyText, expected a String or Null, but received: " ++ show x +#if MIN_VERSION_aeson(2,2,0) + omittedField = Just (NullableNonEmptyText Nothing) +#endif + parseNullableNonEmptyText :: (KnownNat n, 1 <= n) => Text -> J.Object -> J.Parser (NullableNonEmptyText n) parseNullableNonEmptyText fieldName obj = obj .:? J.fromText fieldName .!= nullNonEmptyText @@ -119,6 +136,14 @@ where errorMessage = fail $ "Invalid NullableNonEmptyText. Needs to be < " ++ show (n + 1) ++ " characters, and not entirely whitespace: " ++ s +type IsNullableNonEmptyText n s = + ( KnownSymbol s + , KnownNat n + , SymbolNonEmpty s + , SymbolWithNoSpaceAround s + , SymbolNoLongerThan s n + ) + -- | This requires the text to be non-empty. For the empty text just use the constructor `NullableNonEmptyText Nothing` -literalNullableNonEmptyText :: forall (s :: Symbol) (n :: Nat). (KnownSymbol s, KnownNat n, SymbolNonEmpty s, SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) => NullableNonEmptyText n +literalNullableNonEmptyText :: forall (s :: Symbol) (n :: Nat). IsNullableNonEmptyText n s => NullableNonEmptyText n literalNullableNonEmptyText = NullableNonEmptyText (Just (literalNonEmptyText @s @n)) diff --git a/src/Data/StringVariants/Prose.hs b/src/Data/StringVariants/Prose.hs --- a/src/Data/StringVariants/Prose.hs +++ b/src/Data/StringVariants/Prose.hs @@ -3,6 +3,7 @@ ( Prose, mkProse, compileProse, + IsProse, literalProse, proseToText, proseFromNonEmptyText diff --git a/src/Data/StringVariants/Prose/Internal.hs b/src/Data/StringVariants/Prose/Internal.hs --- a/src/Data/StringVariants/Prose/Internal.hs +++ b/src/Data/StringVariants/Prose/Internal.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TemplateHaskell #-} -- GHC considers the constraints for the prose symbol redundant. @@ -65,7 +66,12 @@ msg s = "Invalid Prose: " <> s <> ". Make sure you aren't wrapping the text in quotes." -literalProse :: forall (s :: Symbol). (KnownSymbol s, SymbolWithNoSpaceAround s) => Prose +type IsProse s = + ( KnownSymbol s + , SymbolWithNoSpaceAround s + ) + +literalProse :: forall (s :: Symbol). IsProse s => Prose literalProse = Prose (T.pack (symbolVal (Proxy @s))) proseToText :: Prose -> Text 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.0. +-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack name: string-variants -version: 0.2.2.0 +version: 0.3.0.0 synopsis: Constrained text newtypes description: See README at . category: Data