Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- data NonEmptyText (n :: Nat)
- type (<=) (x :: k) (y :: k) = (x <=? y) ~ 'True
- mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
- mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
- literalNonEmptyText :: forall (s :: Symbol) (n :: Nat). (KnownSymbol s, KnownNat n, SymbolNonEmpty s, SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) => NonEmptyText n
- unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n
- nonEmptyTextToText :: NonEmptyText n -> Text
- compileNonEmptyText :: Integer -> QuasiQuoter
- compileNonEmptyTextKnownLength :: QuasiQuoter
- convertEmptyTextToNothing :: Text -> Maybe Text
- 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 -> [NonEmptyText chunkSize]
- filterNonEmptyText :: (KnownNat n, 1 <= n) => (Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n)
- (<>|) :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m)
- concatWithSpace :: NonEmptyText n -> NonEmptyText m -> NonEmptyText ((n + m) + 1)
- 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
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
type (<=) (x :: k) (y :: k) = (x <=? y) ~ 'True infix 4 #
Comparison (<=) of comparable types, as a constraint.
Since: base-4.16.0.0
Construction
mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) Source #
mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) Source #
literalNonEmptyText :: forall (s :: Symbol) (n :: Nat). (KnownSymbol s, KnownNat n, SymbolNonEmpty s, SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) => NonEmptyText n Source #
unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n Source #
Make a NonEmptyText when you can manually verify the length
nonEmptyTextToText :: NonEmptyText n -> Text Source #
Conversion
widen :: (1 <= n, n <= m) => NonEmptyText n -> NonEmptyText m Source #
Converts a NonEmptyText
to a wider NonEmptyText
Functions
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 -> [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
concatWithSpace :: NonEmptyText n -> NonEmptyText m -> NonEmptyText ((n + m) + 1) Source #
Concat two NonEmptyText
values with a space in between them. The new
maximum length is the sum of the two maximum lengths of the inputs + 1 for
the space.
Useful for unwords
like operations, or combining first and last names.
Conversions between Refined
and NonEmptyText
.
data ContainsNonWhitespaceCharacters Source #
Instances
exactLengthRefinedToRange :: Refined (ContainsNonWhitespaceCharacters && SizeEqualTo n) Text -> NonEmptyText n Source #