string-variants-0.3.1.0: Constrained text newtypes
Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.StringVariants

Synopsis

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

Instances details
Lift (NonEmptyText n :: Type) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Methods

lift :: Quote m => NonEmptyText n -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => NonEmptyText n -> Code m (NonEmptyText n) #

(KnownNat n, 1 <= n) => Arbitrary (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

(KnownNat n, 1 <= n) => FromJSON (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

ToJSON (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

KnownNat n => Data (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NonEmptyText n -> c (NonEmptyText n) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (NonEmptyText n) #

toConstr :: NonEmptyText n -> Constr #

dataTypeOf :: NonEmptyText n -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (NonEmptyText n)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (NonEmptyText n)) #

gmapT :: (forall b. Data b => b -> b) -> NonEmptyText n -> NonEmptyText n #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NonEmptyText n -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NonEmptyText n -> r #

gmapQ :: (forall d. Data d => d -> u) -> NonEmptyText n -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> NonEmptyText n -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> NonEmptyText n -> m (NonEmptyText n) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmptyText n -> m (NonEmptyText n) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmptyText n -> m (NonEmptyText n) #

(TypeError (('Text "An instance of 'Semigroup (NonEmptyText n)' would violate the " ':<>: 'Text "length guarantees.") ':$$: 'Text "Please use '(<>|)' or 'concatWithSpace' to combine the values.") :: Constraint) => Semigroup (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Generic (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Associated Types

type Rep (NonEmptyText n) :: Type -> Type #

Methods

from :: NonEmptyText n -> Rep (NonEmptyText n) x #

to :: Rep (NonEmptyText n) x -> NonEmptyText n #

Read (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Show (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Eq (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Ord (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

MonoFoldable (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

Methods

ofoldMap :: Monoid m => (Element (NonEmptyText n) -> m) -> NonEmptyText n -> m #

ofoldr :: (Element (NonEmptyText n) -> b -> b) -> b -> NonEmptyText n -> b #

ofoldl' :: (a -> Element (NonEmptyText n) -> a) -> a -> NonEmptyText n -> a #

otoList :: NonEmptyText n -> [Element (NonEmptyText n)] #

oall :: (Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool #

oany :: (Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool #

onull :: NonEmptyText n -> Bool #

olength :: NonEmptyText n -> Int #

olength64 :: NonEmptyText n -> Int64 #

ocompareLength :: Integral i => NonEmptyText n -> i -> Ordering #

otraverse_ :: Applicative f => (Element (NonEmptyText n) -> f b) -> NonEmptyText n -> f () #

ofor_ :: Applicative f => NonEmptyText n -> (Element (NonEmptyText n) -> f b) -> f () #

omapM_ :: Applicative m => (Element (NonEmptyText n) -> m ()) -> NonEmptyText n -> m () #

oforM_ :: Applicative m => NonEmptyText n -> (Element (NonEmptyText n) -> m ()) -> m () #

ofoldlM :: Monad m => (a -> Element (NonEmptyText n) -> m a) -> a -> NonEmptyText n -> m a #

ofoldMap1Ex :: Semigroup m => (Element (NonEmptyText n) -> m) -> NonEmptyText n -> m #

ofoldr1Ex :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Element (NonEmptyText n)) -> NonEmptyText n -> Element (NonEmptyText n) #

ofoldl1Ex' :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Element (NonEmptyText n)) -> NonEmptyText n -> Element (NonEmptyText n) #

headEx :: NonEmptyText n -> Element (NonEmptyText n) #

lastEx :: NonEmptyText n -> Element (NonEmptyText n) #

unsafeHead :: NonEmptyText n -> Element (NonEmptyText n) #

unsafeLast :: NonEmptyText n -> Element (NonEmptyText n) #

maximumByEx :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering) -> NonEmptyText n -> Element (NonEmptyText n) #

minimumByEx :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering) -> NonEmptyText n -> Element (NonEmptyText n) #

oelem :: Element (NonEmptyText n) -> NonEmptyText n -> Bool #

onotElem :: Element (NonEmptyText n) -> NonEmptyText n -> Bool #

ConvertibleStrings (NonEmptyText n) ByteString Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

ConvertibleStrings (NonEmptyText n) Text Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

ConvertibleStrings (NonEmptyText n) String Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

type Rep (NonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

type Rep (NonEmptyText n) = D1 ('MetaData "NonEmptyText" "Data.StringVariants.NonEmptyText.Internal" "string-variants-0.3.1.0-7oZ1CmOM9DaEt259oVGHqF" 'True) (C1 ('MetaCons "NonEmptyText" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))
type Element (NonEmptyText _n) Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText.Internal

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

Converting

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

Instances details
Generic ContainsNonWhitespaceCharacters Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText

Associated Types

type Rep ContainsNonWhitespaceCharacters :: Type -> Type #

Predicate ContainsNonWhitespaceCharacters Text Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText

type Rep ContainsNonWhitespaceCharacters Source # 
Instance details

Defined in Data.StringVariants.NonEmptyText

type Rep ContainsNonWhitespaceCharacters = D1 ('MetaData "ContainsNonWhitespaceCharacters" "Data.StringVariants.NonEmptyText" "string-variants-0.3.1.0-7oZ1CmOM9DaEt259oVGHqF" 'False) (C1 ('MetaCons "ContainsNonWhitespaceCharacters" 'PrefixI 'False) (U1 :: Type -> Type))

Non-empty, whitespace-trimmed text with no character limit

data Prose Source #

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

Instances details
FromJSON Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

ToJSON Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

ToJSONKey Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Semigroup Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

(<>) :: Prose -> Prose -> Prose #

sconcat :: NonEmpty Prose -> Prose #

stimes :: Integral b => b -> Prose -> Prose #

Show Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

showsPrec :: Int -> Prose -> ShowS #

show :: Prose -> String #

showList :: [Prose] -> ShowS #

Eq Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

(==) :: Prose -> Prose -> Bool #

(/=) :: Prose -> Prose -> Bool #

Ord Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

compare :: Prose -> Prose -> Ordering #

(<) :: Prose -> Prose -> Bool #

(<=) :: Prose -> Prose -> Bool #

(>) :: Prose -> Prose -> Bool #

(>=) :: Prose -> Prose -> Bool #

max :: Prose -> Prose -> Prose #

min :: Prose -> Prose -> Prose #

ConvertibleStrings Prose Text Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

convertString :: Prose -> Text #

ConvertibleStrings Prose Text Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

convertString :: Prose -> Text #

Lift Prose Source # 
Instance details

Defined in Data.StringVariants.Prose.Internal

Methods

lift :: Quote m => Prose -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Prose -> Code m Prose #

Nullable non empty text

newtype NullableNonEmptyText n Source #

Newtype wrapper around Maybe NonEmptyText that converts empty string to Nothing.

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.

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

Instances details
Lift (NullableNonEmptyText n :: Type) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

Methods

lift :: Quote m => NullableNonEmptyText n -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => NullableNonEmptyText n -> Code m (NullableNonEmptyText n) #

(KnownNat n, 1 <= n) => FromJSON (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

ToJSON (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

Generic (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

Associated Types

type Rep (NullableNonEmptyText n) :: Type -> Type #

Read (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

Show (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

Eq (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

type Rep (NullableNonEmptyText n) Source # 
Instance details

Defined in Data.StringVariants.NullableNonEmptyText

type Rep (NullableNonEmptyText n) = D1 ('MetaData "NullableNonEmptyText" "Data.StringVariants.NullableNonEmptyText" "string-variants-0.3.1.0-7oZ1CmOM9DaEt259oVGHqF" 'True) (C1 ('MetaCons "NullableNonEmptyText" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (NonEmptyText n)))))

Converting

Information