Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data NonEmptyText (n :: Nat)
- mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
- unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n
- mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
- compileNonEmptyText :: Integer -> QuasiQuoter
- compileNonEmptyTextKnownLength :: QuasiQuoter
- nonEmptyTextToText :: NonEmptyText n -> Text
- convertEmptyTextToNothing :: Text -> Maybe Text
- maybeTextToTruncateNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Maybe Text -> NullableNonEmptyText n
- type (<=) (x :: t) (y :: t) = Assert (x <=? y) (LeErrMsg x y :: Constraint)
- widen :: (1 <= n, n <= m) => NonEmptyText n -> NonEmptyText m
- takeNonEmptyText :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n
- takeNonEmptyTextEnd :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n
- chunksOfNonEmptyText :: forall chunkSize totalSize. (KnownNat chunkSize, KnownNat totalSize, chunkSize <= totalSize, 1 <= chunkSize) => NonEmptyText totalSize -> NonEmpty (NonEmptyText chunkSize)
- filterNonEmptyText :: (KnownNat n, 1 <= n) => (Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n)
- (<>|) :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m)
- data ContainsNonWhitespaceCharacters = ContainsNonWhitespaceCharacters
- exactLengthRefinedToRange :: Refined (ContainsNonWhitespaceCharacters && SizeEqualTo n) Text -> NonEmptyText n
- nonEmptyTextFromRefined :: Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text -> NonEmptyText n
- refinedFromNonEmptyText :: NonEmptyText n -> Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text
- data Prose
- mkProse :: Text -> Maybe Prose
- compileProse :: QuasiQuoter
- proseToText :: Prose -> Text
- proseFromNonEmptyText :: NonEmptyText n -> Prose
- newtype NullableNonEmptyText n = NullableNonEmptyText (Maybe (NonEmptyText n))
- mkNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NullableNonEmptyText n)
- nullNonEmptyText :: NullableNonEmptyText n
- compileNullableNonEmptyText :: Integer -> QuasiQuoter
- nonEmptyTextToNullable :: NonEmptyText n -> NullableNonEmptyText n
- maybeNonEmptyTextToNullable :: Maybe (NonEmptyText n) -> NullableNonEmptyText n
- nullableNonEmptyTextToMaybeText :: NullableNonEmptyText n -> Maybe Text
- nullableNonEmptyTextToMaybeNonEmptyText :: NullableNonEmptyText n -> Maybe (NonEmptyText n)
- parseNullableNonEmptyText :: (KnownNat n, 1 <= n) => Text -> Object -> Parser (NullableNonEmptyText n)
- fromMaybeNullableText :: Maybe (NullableNonEmptyText n) -> NullableNonEmptyText n
- isNullNonEmptyText :: NullableNonEmptyText n -> Bool
Non empty text
data NonEmptyText (n :: Nat) Source #
Non Empty Text, requires the input is between 1 and n
chars and not just whitespace.
Instances
Constructing
mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) Source #
unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n Source #
Make a NonEmptyText when you can manually verify the length
mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) Source #
Converting
nonEmptyTextToText :: NonEmptyText n -> Text Source #
maybeTextToTruncateNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Maybe Text -> NullableNonEmptyText n Source #
type (<=) (x :: t) (y :: t) = Assert (x <=? y) (LeErrMsg x y :: Constraint) infix 4 #
Comparison (<=) of comparable types, as a constraint.
Since: base-4.16.0.0
widen :: (1 <= n, n <= m) => NonEmptyText n -> NonEmptyText m Source #
Converts a NonEmptyText
to a wider NonEmptyText
Operations
takeNonEmptyText :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n Source #
Narrows the maximum length, dropping any remaining trailing characters.
takeNonEmptyTextEnd :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n Source #
Narrows the maximum length, dropping any prefix remaining characters.
chunksOfNonEmptyText :: forall chunkSize totalSize. (KnownNat chunkSize, KnownNat totalSize, chunkSize <= totalSize, 1 <= chunkSize) => NonEmptyText totalSize -> NonEmpty (NonEmptyText chunkSize) Source #
O(n) Splits a NonEmptyText
into components of length chunkSize
. The
chunks may be shorter than the chunkSize depending on the length
of the input and spacing. Each chunk is stripped of whitespace.
filterNonEmptyText :: (KnownNat n, 1 <= n) => (Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n) Source #
Identical to the normal text filter function, but maintains the type-level invariant that the text length is <= n, unlike unwrapping the text, filtering, then rewrapping the text.
Will return Nothing if the resulting length is zero.
(<>|) :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m) Source #
Concat two NonEmptyText values, with the new maximum length being the sum of the two maximum lengths of the inputs.
Mnemonic: <>
for monoid, |
from NonEmpty's :|
operator
Conversions between Refined
and NonEmptyText
.
data ContainsNonWhitespaceCharacters Source #
Instances
exactLengthRefinedToRange :: Refined (ContainsNonWhitespaceCharacters && SizeEqualTo n) Text -> NonEmptyText n Source #
nonEmptyTextFromRefined :: Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text -> NonEmptyText n Source #
refinedFromNonEmptyText :: NonEmptyText n -> Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text Source #
Non-empty, whitespace-trimmed text with no character limit
Whitespace-trimmed, non-empty text, for use with API endpoints.
The rationale is that there are many situations where if a client sends
text that is empty or all whitespace, there's probably a client error.
Not suitable for database fields, as there is no character limit (see
ProsePersistFieldMsg
).
Instances
FromJSON Prose Source # | |
Defined in Data.StringVariants.Prose.Internal | |
ToJSON Prose Source # | |
ToJSONKey Prose Source # | |
Defined in Data.StringVariants.Prose.Internal | |
Semigroup Prose Source # | |
Show Prose Source # | |
Eq Prose Source # | |
Ord Prose Source # | |
ConvertibleStrings Prose Text Source # | |
Defined in Data.StringVariants.Prose.Internal convertString :: Prose -> Text # | |
ConvertibleStrings Prose Text Source # | |
Defined in Data.StringVariants.Prose.Internal convertString :: Prose -> Text # | |
Lift Prose Source # | |
proseToText :: Prose -> Text Source #
proseFromNonEmptyText :: NonEmptyText n -> Prose Source #
Nullable non empty text
newtype NullableNonEmptyText n Source #
Newtype wrapper around Maybe NonEmptyText that converts empty string to Nothing
.
is used in API types to represent optional text fields when you do not want an empty string to fail to parse.
Like NullableNonEmptyText
nNonEmptyText
, 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
.
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.
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
.
Instances
mkNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NullableNonEmptyText n) Source #
Converting
nullableNonEmptyTextToMaybeNonEmptyText :: NullableNonEmptyText n -> Maybe (NonEmptyText n) Source #
parseNullableNonEmptyText :: (KnownNat n, 1 <= n) => Text -> Object -> Parser (NullableNonEmptyText n) Source #