packages feed

string-variants 0.1.0.2 → 0.2.0.0

raw patch · 13 files changed

+361/−61 lines, 13 filesdep +HUnitdep +hedgehogdep +hspecdep ~basenew-uploader

Dependencies added: HUnit, hedgehog, hspec, hspec-core, hspec-expectations, hspec-hedgehog, string-variants

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## [0.2.0.0] - 2022-12-05++- Add `literalNonEmptyText`, `literalProse`, `literalNullableNonEmptyText` for creation of string variants from the type-level literals.+- Add `concatWithSpace` to concatenate NonEmptyText in a type-safe way.+- Drop support for GHC <9.2.+ ## [0.1.0.2] - 2022-10-18  - Fix `mkNonEmptyTextWithTruncate` to perform truncation after character stripping.
src/Data/StringVariants.hs view
@@ -51,10 +51,6 @@      -- ** Information     isNullNonEmptyText,--    -- * Convenience util if you need a NonEmptyText of a dynamically determined lengths-    useNat,-    natOfLength,   ) where
src/Data/StringVariants/NonEmptyText.hs view
@@ -13,6 +13,7 @@     -- * Construction     mkNonEmptyText,     mkNonEmptyTextWithTruncate,+    literalNonEmptyText,     unsafeMkNonEmptyText,     nonEmptyTextToText,     compileNonEmptyText,@@ -28,27 +29,25 @@     chunksOfNonEmptyText,     filterNonEmptyText,     (<>|),+    concatWithSpace,      -- * Conversions between 'Refined' and 'NonEmptyText'.     ContainsNonWhitespaceCharacters (..),     exactLengthRefinedToRange,     nonEmptyTextFromRefined,     refinedFromNonEmptyText,--    -- * Convenience util if you need a NonEmptyText of a dynamically determined lengths-    useNat,-    natOfLength,   ) where  import Control.Monad import Data.Data (Proxy (..), typeRep)+import Data.Maybe (mapMaybe) import Data.StringVariants.NonEmptyText.Internal import Data.StringVariants.Util import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)-import GHC.TypeLits (KnownNat, natVal, type (+), type (<=))+import GHC.TypeLits (KnownNat, KnownSymbol, Symbol, Nat, natVal, symbolVal, type (+), type (<=)) import Language.Haskell.TH import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax (Lift (..))@@ -66,11 +65,16 @@     }   where     compileNonEmptyText' :: String -> Q Exp-    compileNonEmptyText' s = useNat n $ \p ->-      case natOfLength p $ mkNonEmptyText (T.pack s) of-        Nothing -> fail $ "Invalid NonEmptyText. Needs to be < " ++ show (n + 1) ++ " characters, and not entirely whitespace: " ++ s+    compileNonEmptyText' s = usePositiveNat n errorMessage $ \(_ :: proxy n) ->+      case mkNonEmptyText @n (T.pack s) of         Just txt -> [|$(lift txt) :: NonEmptyText $(pure $ LitT $ NumTyLit n)|]+        Nothing -> errorMessage+      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+literalNonEmptyText = NonEmptyText (T.pack (symbolVal (Proxy @s)))+ convertEmptyTextToNothing :: Text -> Maybe Text convertEmptyTextToNothing t   | textIsWhitespace t = Nothing@@ -82,39 +86,43 @@ -- | 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.-filterNonEmptyText :: (Char -> Bool) -> NonEmptyText n -> NonEmptyText n-filterNonEmptyText f (NonEmptyText t) = NonEmptyText (T.filter f t)+--+-- Will return Nothing if the resulting length is zero.+filterNonEmptyText :: (KnownNat n, 1 <= n) => (Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n)+filterNonEmptyText f (NonEmptyText t) = mkNonEmptyText (T.filter f t)  -- | Narrows the maximum length, dropping any remaining trailing characters.-takeNonEmptyText :: forall m n. (KnownNat m, KnownNat n, n <= m) => NonEmptyText m -> NonEmptyText n+takeNonEmptyText :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n takeNonEmptyText (NonEmptyText t) =   if m == n     then NonEmptyText t-    else NonEmptyText $ T.take n t+    -- when the input is stripped, taking from it is guaranteed to be not empty+    else NonEmptyText $ T.stripEnd $ T.take n t   where     m = fromIntegral $ natVal (Proxy @m)     n = fromIntegral $ natVal (Proxy @n)  -- | Narrows the maximum length, dropping any prefix remaining characters.-takeNonEmptyTextEnd :: forall m n. (KnownNat m, KnownNat n, n <= m) => NonEmptyText m -> NonEmptyText n+takeNonEmptyTextEnd :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n takeNonEmptyTextEnd (NonEmptyText t) =   if m == n     then NonEmptyText t-    else NonEmptyText $ T.takeEnd n t+    -- when the input is stripped, taking from it is guaranteed to be not empty+    else NonEmptyText $ T.stripStart $ T.takeEnd n t   where     m = fromIntegral $ natVal (Proxy @m)     n = fromIntegral $ natVal (Proxy @n)  -- | /O(n)/ Splits a 'NonEmptyText' into components of length @chunkSize@. The--- last element may be shorter than the other chunks, depending on the length--- of the input.+-- chunks may be shorter than the chunkSize depending on the length+-- of the input and spacing. Each chunk is stripped of whitespace. chunksOfNonEmptyText ::   forall chunkSize totalSize.-  (KnownNat chunkSize, KnownNat totalSize) =>+  (KnownNat chunkSize, KnownNat totalSize, chunkSize <= totalSize, 1 <= chunkSize) =>   NonEmptyText totalSize ->   [NonEmptyText chunkSize] chunksOfNonEmptyText (NonEmptyText t) =-  map NonEmptyText (T.chunksOf chunkSize t)+  mapMaybe mkNonEmptyText (T.chunksOf chunkSize t)   where     chunkSize = fromIntegral $ natVal (Proxy @chunkSize) @@ -124,6 +132,14 @@ -- Mnemonic: @<>@ for monoid, @|@ from NonEmpty's ':|' operator (<>|) :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m) (NonEmptyText l) <>| (NonEmptyText r) = NonEmptyText (l <> r)++-- | 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.+concatWithSpace :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m + 1)+concatWithSpace (NonEmptyText l)  (NonEmptyText r) = NonEmptyText (l <> " " <> r)  -- Refinery
src/Data/StringVariants/NonEmptyText/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-} -- We need redundant constraints in @widen@ to enforce invariants {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} @@ -17,7 +18,7 @@ import Data.Proxy import Data.Sequences import Data.String.Conversions (ConvertibleStrings (..), cs)-import Data.StringVariants.Util (textHasNoMeaningfulContent, textIsTooLong, textIsWhitespace)+import Data.StringVariants.Util (textHasNoMeaningfulContent, textIsWhitespace) import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)@@ -34,7 +35,7 @@  type instance Element (NonEmptyText _n) = Char -instance KnownNat n => FromJSON (NonEmptyText n) where+instance (KnownNat n, 1 <= n) => FromJSON (NonEmptyText n) where   parseJSON = withText "NonEmptyText" $ \t -> do     performInboundValidations t     case mkNonEmptyText t of@@ -65,7 +66,7 @@ instance ConvertibleStrings (NonEmptyText n) ByteString where   convertString (NonEmptyText t) = cs t -instance KnownNat n => Arbitrary (NonEmptyText n) where+instance (KnownNat n, 1 <= n) => Arbitrary (NonEmptyText n) where   arbitrary =     NonEmptyText @n <$> do       size <- chooseInt (1, fromIntegral (natVal (Proxy :: Proxy n)) - 1)@@ -73,15 +74,15 @@       str <- replicateM size $ elements ['0' .. 'z']       pure $ T.pack str -mkNonEmptyText :: forall n. KnownNat n => Text -> Maybe (NonEmptyText n)+mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) mkNonEmptyText t-  | textIsTooLong stripped (fromIntegral $ natVal (Proxy @n)) = Nothing+  | T.compareLength stripped (fromIntegral $ natVal (Proxy @n)) == GT = Nothing   | textIsWhitespace stripped = Nothing   | otherwise = Just (NonEmptyText stripped)   where     stripped = T.filter (/= '\NUL') $ T.strip t -mkNonEmptyTextWithTruncate :: forall n. KnownNat n => Text -> Maybe (NonEmptyText n)+mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n) mkNonEmptyTextWithTruncate t   | textIsWhitespace stripped = Nothing   | otherwise = Just (NonEmptyText $ T.stripEnd $ T.take (fromIntegral $ natVal (Proxy @n)) stripped)@@ -89,7 +90,7 @@     stripped = T.filter (/= '\NUL') $ T.stripStart t  -- | Make a NonEmptyText when you can manually verify the length-unsafeMkNonEmptyText :: forall n. KnownNat n => Text -> NonEmptyText n+unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n unsafeMkNonEmptyText = NonEmptyText  -- | Converts a 'NonEmptyText' to a wider NonEmptyText
src/Data/StringVariants/NullableNonEmptyText.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.StringVariants.NullableNonEmptyText   ( -- Safe to construct, so we can export the contents@@ -7,6 +9,7 @@     -- * Constructing     mkNonEmptyTextWithTruncate,     compileNullableNonEmptyText,+    literalNullableNonEmptyText,     mkNullableNonEmptyText,     parseNullableNonEmptyText,     nullNonEmptyText,@@ -32,11 +35,11 @@ import Data.Data (Proxy (..)) import Data.Maybe (fromMaybe) import Data.StringVariants.NonEmptyText-import Data.StringVariants.Util (textIsTooLong)+import Data.StringVariants.Util import Data.Text (Text) import Data.Text qualified as T import GHC.Generics (Generic)-import GHC.TypeLits (KnownNat, natVal)+import GHC.TypeLits (KnownNat, KnownSymbol, Nat, Symbol, natVal) import Language.Haskell.TH import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax (Lift (..))@@ -58,9 +61,9 @@   deriving stock (Generic, Show, Read, Lift)   deriving newtype (Eq, ToJSON) -mkNullableNonEmptyText :: forall n. KnownNat n => Text -> Maybe (NullableNonEmptyText n)+mkNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NullableNonEmptyText n) mkNullableNonEmptyText t-  | textIsTooLong t (fromIntegral $ natVal (Proxy @n)) = Nothing -- we can't store text that is too long+  | T.compareLength t (fromIntegral $ natVal (Proxy @n)) == GT = Nothing -- we can't store text that is too long   | otherwise = Just $ NullableNonEmptyText $ mkNonEmptyText t  nullNonEmptyText :: NullableNonEmptyText n@@ -69,7 +72,7 @@ isNullNonEmptyText :: NullableNonEmptyText n -> Bool isNullNonEmptyText = (== nullNonEmptyText) -instance KnownNat n => FromJSON (NullableNonEmptyText n) where+instance (KnownNat n, 1 <= n) => FromJSON (NullableNonEmptyText n) where   parseJSON = \case     J.String t -> case mkNullableNonEmptyText t of       Just txt -> pure txt@@ -77,7 +80,7 @@     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 -parseNullableNonEmptyText :: KnownNat n => Text -> J.Object -> J.Parser (NullableNonEmptyText n)+parseNullableNonEmptyText :: (KnownNat n, 1 <= n) => Text -> J.Object -> J.Parser (NullableNonEmptyText n) parseNullableNonEmptyText fieldName obj = obj .:? J.fromText fieldName .!= nullNonEmptyText  fromMaybeNullableText :: Maybe (NullableNonEmptyText n) -> NullableNonEmptyText n@@ -90,7 +93,7 @@ maybeNonEmptyTextToNullable Nothing = nullNonEmptyText maybeNonEmptyTextToNullable jt = NullableNonEmptyText jt -maybeTextToTruncateNullableNonEmptyText :: forall n. KnownNat n => Maybe Text -> NullableNonEmptyText n+maybeTextToTruncateNullableNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Maybe Text -> NullableNonEmptyText n maybeTextToTruncateNullableNonEmptyText mText = NullableNonEmptyText $ mText >>= mkNonEmptyText . T.take (fromInteger (natVal (Proxy @n)))  nullableNonEmptyTextToMaybeNonEmptyText :: NullableNonEmptyText n -> Maybe (NonEmptyText n)@@ -109,7 +112,13 @@     }   where     compileNullableNonEmptyText' :: String -> Q Exp-    compileNullableNonEmptyText' s = useNat n $ \p ->-      case natOfLength p $ mkNullableNonEmptyText (T.pack s) of-        Nothing -> fail $ "Invalid NullableNonEmptyText. Needs to be < " ++ show (n + 1) ++ " characters, and not entirely whitespace: " ++ s+    compileNullableNonEmptyText' s = usePositiveNat n errorMessage $ \(_ :: proxy n) ->+      case mkNullableNonEmptyText @n (T.pack s) of         Just txt -> [|$(lift txt)|]+        Nothing -> errorMessage+      where+        errorMessage = fail $ "Invalid NullableNonEmptyText. Needs to be < " ++ show (n + 1) ++ " characters, and not entirely whitespace: " ++ s++-- | 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 = NullableNonEmptyText (Just (literalNonEmptyText @s @n))
src/Data/StringVariants/Prose.hs view
@@ -3,6 +3,7 @@   ( Prose,     mkProse,     compileProse,+    literalProse,     proseToText,   ) where
src/Data/StringVariants/Prose/Internal.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} +-- GHC considers the constraints for the prose symbol redundant.+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+ -- | Internal module of Prose, allowing breaking the abstraction. -- --   Prefer to use "Data.StringVariants.Prose" instead.@@ -8,9 +11,12 @@ import Data.Aeson (FromJSON, ToJSON, ToJSONKey, withText) import Data.Aeson.Types (FromJSON (..)) import Data.String.Conversions (ConvertibleStrings (..), cs)+import Data.StringVariants.Util (SymbolWithNoSpaceAround)+import Data.Proxy import Data.Text (Text) import Data.Text qualified as T import Data.Text.Lazy qualified as LT+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import Language.Haskell.TH.Quote import Language.Haskell.TH.Syntax import Prelude@@ -54,6 +60,9 @@       Just s' -> [|$(lift s')|]      msg s = "Invalid Prose: " <> s <> ". Make sure you aren't wrapping the text in quotes."++literalProse :: forall (s :: Symbol). (KnownSymbol s, SymbolWithNoSpaceAround s) => Prose+literalProse = Prose (T.pack (symbolVal (Proxy @s)))  proseToText :: Prose -> Text proseToText (Prose txt) = txt
src/Data/StringVariants/Util.hs view
@@ -1,31 +1,69 @@-module Data.StringVariants.Util (natOfLength, useNat, textIsTooLong, textIsWhitespace, textHasNoMeaningfulContent) where-import GHC.TypeLits (KnownNat, Nat, SomeNat (..), someNatVal)+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.StringVariants.Util (SymbolNonEmpty, SymbolWithNoSpaceAround, SymbolNoLongerThan, usePositiveNat, textIsWhitespace, textHasNoMeaningfulContent) where++import Data.Proxy+import Data.Kind (Constraint)+import Data.Type.Bool+import Data.Type.Equality+import GHC.TypeLits import Prelude import Data.Text (Text) import qualified Data.Text as T import Data.Char (isSpace, isControl) -textIsTooLong :: Text -> Int -> Bool--- why take? because of stream fusion,--- length isn't O(1), it's O(n). which means--- it's better to cut off the text at @n@--- and then evaluate the resulting stream, than--- to evaluate the entire stream. very unintuitive,--- but that's just the way things are :(-textIsTooLong t n = T.length (T.take (n + 1) t) >= (n + 1)- textIsWhitespace :: Text -> Bool textIsWhitespace = T.all isSpace  textHasNoMeaningfulContent :: Text -> Bool textHasNoMeaningfulContent = T.all (\c -> isSpace c || isControl c) +-- | If the integer is >= 1, evaluate the function with the proof of that. Otherwise, return the default value+usePositiveNat :: Integer -> a -> (forall n proxy. (KnownNat n, 1 <= n) => proxy n -> a) -> a+usePositiveNat n a f = case someNatVal n of+  Nothing -> a+  Just (SomeNat p) -> case cmpNat (Proxy @1) p of+    EQI -> f p+    LTI -> f p+    GTI -> a -natOfLength :: proxy (n :: Nat) -> f (other n) -> f (other n)-natOfLength _ = id+-- Logic ported from base-4.17 Data.Char.isSpace.+-- Hopefully, GHC would add this type-level function+type IsCharWhitespace c+  = If+    (CharToNat c <=? 0x376)+    (CharToNat c == 32 || CharToNat c - 0x9 <=? 4 || CharToNat c == 0xa0)+    (IsUnicodeWhitespaceCodePoint (CharToNat c)) -useNat :: Integer -> (forall n proxy. KnownNat n => proxy n -> x) -> x-useNat n f = case someNatVal n of-  Nothing -> error (show n ++ " isn't a valid Nat")-  Just (SomeNat p) -> f p+-- It checks the whitespace characters (Unicode property White_Space=yes) defined in Unicode 15.0.0 and above the ASCII range.+type IsUnicodeWhitespaceCodePoint n+  = n == 0x1680+  || (0x2000 <=? n && n <=? 0x200A)+  || n == 0x2028 || n == 0x2029 || n == 0x202F || n == 0x205F || n == 0x3000 +type family SymbolLength (length :: Nat) (s :: Maybe (Char, Symbol)) :: Nat where+  SymbolLength length 'Nothing = length+  SymbolLength length ('Just '(_, s)) = SymbolLength (length + 1) (UnconsSymbol s)++type family SymbolNonEmpty (s :: Symbol) :: Constraint where+  SymbolNonEmpty "" = TypeError ('Text "Symbol is empty")+  SymbolNonEmpty _ = ()++type family SymbolNoLeadingSpace (s :: Maybe (Char, Symbol)) :: Constraint where+  SymbolNoLeadingSpace 'Nothing = ()+  SymbolNoLeadingSpace ('Just '(c, _)) = If (IsCharWhitespace c) (TypeError ('Text "Symbol has leading whitespace")) (() :: Constraint)++type family SymbolNoTrailingSpace (s :: Maybe (Char, Symbol)) :: Constraint where+  SymbolNoTrailingSpace 'Nothing = ()+  SymbolNoTrailingSpace ('Just '(c, "")) = If (IsCharWhitespace c) (TypeError ('Text "Symbol has trailing whitespace")) (() :: Constraint)+  SymbolNoTrailingSpace ('Just '(_, s)) = SymbolNoTrailingSpace (UnconsSymbol s)++-- The type family IsCharWhitespace is large but it is only evaluated for the first and last symbols+type SymbolWithNoSpaceAround s = (SymbolNoLeadingSpace (UnconsSymbol s), SymbolNoTrailingSpace (UnconsSymbol s)) ++type family SymbolNoLongerThan (s :: Symbol) (n :: Nat) :: Constraint where+  SymbolNoLongerThan s n = If (SymbolLength 0 (UnconsSymbol s) <=? n)+    (() :: Constraint)+    (TypeError ('Text "Invalid NonEmptyText. Needs to be <= " ':<>: 'ShowType n ':<>: 'Text " characters. Has " ':<>: 'ShowType (SymbolLength 0 (UnconsSymbol s)) ':<>: 'Text " characters."))
string-variants.cabal view
@@ -1,22 +1,22 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.7.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           string-variants-version:        0.1.0.2+version:        0.2.0.0 synopsis:       Constrained text newtypes description:    See README at <https://github.com/MercuryTechnologies/string-variants#readme>. category:       Data homepage:       https://github.com/MercuryTechnologies/string-variants#readme bug-reports:    https://github.com/MercuryTechnologies/string-variants/issues-maintainer:     Jade Lovelace <jadel@mercury.com>+maintainer:     Jade Lovelace <jadel@mercury.com>, Borys Lykakh <borys@fastmail.com> license:        MIT license-file:   LICENSE build-type:     Simple tested-with:-    GHC ==8.10.7 || ==9.2.4 || ==9.4.2+    GHC ==9.2.4 || ==9.4.2 extra-source-files:     CHANGELOG.md @@ -77,12 +77,81 @@   build-depends:       QuickCheck     , aeson >=2.0.0.0-    , base >=4.9 && <5+    , base >=4.16 && <5     , bytestring     , mono-traversable     , refined     , refinery     , string-conversions+    , template-haskell+    , text+  default-language: Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Spec+      Specs.NonEmptySpec+      Specs.TextManipulationSpec+      Paths_string_variants+  hs-source-dirs:+      test+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BlockArguments+      DataKinds+      DeriveAnyClass+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingVia+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      ImportQualifiedPost+      InstanceSigs+      LambdaCase+      MonoLocalBinds+      MultiWayIf+      NamedFieldPuns+      NumericUnderscores+      OverloadedStrings+      PatternSynonyms+      PolyKinds+      RankNTypes+      RecordWildCards+      RecursiveDo+      ScopedTypeVariables+      StandaloneDeriving+      StandaloneKindSignatures+      TypeApplications+      TypeFamilies+      ViewPatterns+  ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-export-lists -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-missing-kind-signatures -threaded -rtsopts -with-rtsopts=-N -Wno-incomplete-uni-patterns -O0+  build-tool-depends:+      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   default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Spec qualified+import Test.Hspec+import Test.Hspec.Runner (defaultConfig, hspecWith)+import Prelude++main :: IO ()+main =+  hspecWith defaultConfig $+    parallel Spec.spec
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
+ test/Specs/NonEmptySpec.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Specs.NonEmptySpec (spec) where++import Data.Maybe+import Data.Text (Text)+import Data.Text qualified as T+import Data.StringVariants.NonEmptyText+import Data.StringVariants.NullableNonEmptyText+import Data.StringVariants.Util (usePositiveNat)+import GHC.TypeLits+import Hedgehog+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import Language.Haskell.TH.Quote (QuasiQuoter (quoteExp))+import Prelude+import Test.Hspec+import Test.Hspec.Hedgehog (hedgehog)++mkNonEmptyText299 :: Text -> Maybe (NonEmptyText 299)+mkNonEmptyText299 = mkNonEmptyText++maybeTextToTruncateNullableNonEmptyText299 :: Maybe Text -> NullableNonEmptyText 299+maybeTextToTruncateNullableNonEmptyText299 = maybeTextToTruncateNullableNonEmptyText++mkNonEmptyText299WithTruncate :: Text -> Maybe (NonEmptyText 299)+mkNonEmptyText299WithTruncate = mkNonEmptyTextWithTruncate++matchLength :: proxy (n :: Nat) -> other n -> other n+matchLength _ = id++spec :: Spec+spec = describe "NonEmptyText variants" $ do+  describe "NonEmptyText299" $ do+    describe "compileNonEmptyText" $ do+      it "should work" $ do+        mkNonEmptyText299 "hi" `shouldBe` Just (widen [compileNonEmptyTextKnownLength|hi|])+    describe "compileNullableNonEmptyText" $ do+      it "should work" $ do+        $(quoteExp (compileNullableNonEmptyText 2) "yo") `shouldBe` NullableNonEmptyText (Just [compileNonEmptyTextKnownLength|yo|])+    describe "nonEmptyTextToText" $ do+      it "should work" $ do+        nonEmptyTextToText [compileNonEmptyTextKnownLength|yo|] `shouldBe` "yo"++  describe "Generalized NonEmptyText" $ do+    describe "mkNonEmptyText" $+      it "should work" $ do+        mkNonEmptyText299 "" `shouldBe` Nothing+        mkNonEmptyText299 " " `shouldBe` Nothing+        mkNonEmptyText299 "\n" `shouldBe` Nothing+        mkNonEmptyText299 "\t" `shouldBe` Nothing+        mkNonEmptyText299 "\NUL" `shouldBe` Nothing+        mkNonEmptyText299 "x" `shouldSatisfy` isJust++    describe "literalNonEmptyText" $ do+      it "should work" $ do+        Just (literalNonEmptyText @"abc def") `shouldBe` mkNonEmptyText299 "abc def"++-- test cases for bad strings. Alas, the -fdefer-type-errors defers the errors but then happily creates invalid values in runtime. Is this a GHC bug?++      -- describe "rejects invalid strings" $ do+      --   it "rejects string too long" $ do+      --     print (literalNonEmptyText @"abcdefghijkl" :: NonEmptyText 10)+      --       `shouldThrow` (("Invalid NonEmptyText. Needs to be <= 10 characters. Has 12 characters." `isInfixOf`) . show)+      --   it "rejects empty string" $ do+      --     print (literalNonEmptyText @"" :: NonEmptyText 10)+      --       `shouldThrow` (("Symbol is empty" `isInfixOf`) . show)+      --   it "rejects string with leading whitespace" $ do+      --     print (literalNonEmptyText @" abc" :: NonEmptyText 10)+      --       `shouldThrow` (("Symbol has leading whitespace" `isInfixOf`) . show)+      --   it "rejects string with trailing whitespace" $ do+      --     print (literalNonEmptyText @"abc " :: NonEmptyText 10)+      --       `shouldThrow` (("Symbol has leading whitespace" `isInfixOf`) . show)+      --   it "rejects string with leading unicode whitespace" $ do+      --     print (literalNonEmptyText @"\x2000abc" :: NonEmptyText 10)+      --       `shouldThrow` (("Symbol has leading whitespace" `isInfixOf`) . show)++    describe "maybeTextToTruncateNullableNonEmptyText" $ do+      it "common behavior" $ do+        maybeTextToTruncateNullableNonEmptyText299 Nothing `shouldBe` NullableNonEmptyText Nothing+        maybeTextToTruncateNullableNonEmptyText299 (Just "") `shouldBe` NullableNonEmptyText Nothing+        maybeTextToTruncateNullableNonEmptyText299 (Just " ") `shouldBe` NullableNonEmptyText Nothing+      it "type-dependent behavior" $+        hedgehog $ do+          n <- forAll $ Gen.integral $ Range.constant 1 20000+          let n' = fromInteger n+          usePositiveNat n (pure ()) $ \p -> do+            let NullableNonEmptyText mtext =+                  matchLength p $+                    maybeTextToTruncateNullableNonEmptyText+                      (Just $ T.pack $ replicate (n' + 1) 'x')+            (T.length . nonEmptyTextToText <$> mtext) === Just n'++    describe "mkNonEmptyTextWithTruncate" $ do+      it "common behavior" $ do+        mkNonEmptyText299WithTruncate "" `shouldBe` Nothing+        mkNonEmptyText299WithTruncate " " `shouldBe` Nothing+      it "type-dependent behavior" $+        hedgehog $ do+          n <- forAll $ Gen.integral $ Range.constant 1 20000+          let n' = fromInteger n+          usePositiveNat n (pure ()) $ \(_ :: proxy n) -> do+            let mtext = mkNonEmptyTextWithTruncate @n (T.pack $ replicate (n' + 1) 'x')+            (T.length . nonEmptyTextToText <$> mtext) === Just n'
+ test/Specs/TextManipulationSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE QuasiQuotes #-}++module Specs.TextManipulationSpec (spec) where++import Data.Char+import Data.StringVariants.NonEmptyText+import Test.Hspec+import Prelude++spec :: Spec+spec = describe "Text manipulation" do+  describe "filterNonEmptyText" $ do+    it "filterNonEmptyText returns Nothing when filtered string is empty" do+      filterNonEmptyText (const False) [compileNonEmptyTextKnownLength|abc|] `shouldBe` Nothing++    it "filterNonEmptyText returns Nothing when filtered string only has spaces" do+      filterNonEmptyText isSpace [compileNonEmptyTextKnownLength|a b|] `shouldBe` Nothing++    it "filterNonEmptyText returns stripped text" do+      filterNonEmptyText (/= 'a') [compileNonEmptyTextKnownLength|a b a|] `shouldBe` Just (widen [compileNonEmptyTextKnownLength|b|])++  describe "takeNonEmptyText" $ do+    it "takeNonEmptyText returns stripped text" do+      -- taking two characters results in a trailing space+      takeNonEmptyText [compileNonEmptyTextKnownLength|a b|] `shouldBe` (widen [compileNonEmptyTextKnownLength|a|] :: NonEmptyText 2)++  describe "takeNonEmptyTextEnd" $ do+    it "takeNonEmptyTextEnd returns stripped text" do+      -- taking two characters results in a leading space+      takeNonEmptyTextEnd [compileNonEmptyTextKnownLength|a b|] `shouldBe` (widen [compileNonEmptyTextKnownLength|b|] :: NonEmptyText 2)++  describe "chunksOfNonEmptyText" $ do+    it "chunksOfNonEmptyText drops empty chunks" $ do+      chunksOfNonEmptyText [compileNonEmptyTextKnownLength|a   b|]+        `shouldBe` ([[compileNonEmptyTextKnownLength|a|], [compileNonEmptyTextKnownLength|b|]] :: [NonEmptyText 1])+    it "chunksOfNonEmptyText strips chunks" $ do+      chunksOfNonEmptyText [compileNonEmptyTextKnownLength|a   b|]+        `shouldBe` ([widen [compileNonEmptyTextKnownLength|a|], widen [compileNonEmptyTextKnownLength|b|]] :: [NonEmptyText 2])