{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
-- We need redundant constraints in @widen@ to enforce invariants
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | Internal module of NonEmptyText, allowing breaking the abstraction.
--
--   Prefer to use "Data.StringVariants.NonEmptyText" instead.

module Data.StringVariants.NonEmptyText.Internal where

import Control.Monad (when)
import Data.Aeson (FromJSON (..), ToJSON, withText)
import Data.ByteString
import Data.Coerce
import Data.MonoTraversable
import Data.Proxy
import Data.Sequences
import Data.String.Conversions (ConvertibleStrings (..), cs)
import Data.StringVariants.Util (textHasNoMeaningfulContent, textIsWhitespace)
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.TypeLits (KnownNat, Nat, natVal, type (<=))
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax (Lift (..), TyLit (..), Type (..))
import Test.QuickCheck
import Prelude

-- | Non Empty Text, requires the input is between 1 and @n@ chars and not just whitespace.
newtype NonEmptyText (n :: Nat) = NonEmptyText Text
  deriving stock (forall (n :: Natural) x. Rep (NonEmptyText n) x -> NonEmptyText n
forall (n :: Natural) x. NonEmptyText n -> Rep (NonEmptyText n) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (n :: Natural) x. Rep (NonEmptyText n) x -> NonEmptyText n
$cfrom :: forall (n :: Natural) x. NonEmptyText n -> Rep (NonEmptyText n) x
Generic, Int -> NonEmptyText n -> ShowS
forall (n :: Natural). Int -> NonEmptyText n -> ShowS
forall (n :: Natural). [NonEmptyText n] -> ShowS
forall (n :: Natural). NonEmptyText n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NonEmptyText n] -> ShowS
$cshowList :: forall (n :: Natural). [NonEmptyText n] -> ShowS
show :: NonEmptyText n -> String
$cshow :: forall (n :: Natural). NonEmptyText n -> String
showsPrec :: Int -> NonEmptyText n -> ShowS
$cshowsPrec :: forall (n :: Natural). Int -> NonEmptyText n -> ShowS
Show, ReadPrec [NonEmptyText n]
ReadPrec (NonEmptyText n)
ReadS [NonEmptyText n]
forall (n :: Natural). ReadPrec [NonEmptyText n]
forall (n :: Natural). ReadPrec (NonEmptyText n)
forall (n :: Natural). Int -> ReadS (NonEmptyText n)
forall (n :: Natural). ReadS [NonEmptyText n]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NonEmptyText n]
$creadListPrec :: forall (n :: Natural). ReadPrec [NonEmptyText n]
readPrec :: ReadPrec (NonEmptyText n)
$creadPrec :: forall (n :: Natural). ReadPrec (NonEmptyText n)
readList :: ReadS [NonEmptyText n]
$creadList :: forall (n :: Natural). ReadS [NonEmptyText n]
readsPrec :: Int -> ReadS (NonEmptyText n)
$creadsPrec :: forall (n :: Natural). Int -> ReadS (NonEmptyText n)
Read, forall (n :: Natural) (m :: * -> *).
Quote m =>
NonEmptyText n -> m Exp
forall (n :: Natural) (m :: * -> *).
Quote m =>
NonEmptyText n -> Code m (NonEmptyText n)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => NonEmptyText n -> m Exp
forall (m :: * -> *).
Quote m =>
NonEmptyText n -> Code m (NonEmptyText n)
liftTyped :: forall (m :: * -> *).
Quote m =>
NonEmptyText n -> Code m (NonEmptyText n)
$cliftTyped :: forall (n :: Natural) (m :: * -> *).
Quote m =>
NonEmptyText n -> Code m (NonEmptyText n)
lift :: forall (m :: * -> *). Quote m => NonEmptyText n -> m Exp
$clift :: forall (n :: Natural) (m :: * -> *).
Quote m =>
NonEmptyText n -> m Exp
Lift)
  deriving newtype (NonEmptyText n -> NonEmptyText n -> Bool
forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NonEmptyText n -> NonEmptyText n -> Bool
$c/= :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
== :: NonEmptyText n -> NonEmptyText n -> Bool
$c== :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
Eq, NonEmptyText n -> NonEmptyText n -> Bool
NonEmptyText n -> NonEmptyText n -> Ordering
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
forall (n :: Natural). Eq (NonEmptyText n)
forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Ordering
forall (n :: Natural).
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NonEmptyText n -> NonEmptyText n -> NonEmptyText n
$cmin :: forall (n :: Natural).
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
max :: NonEmptyText n -> NonEmptyText n -> NonEmptyText n
$cmax :: forall (n :: Natural).
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
>= :: NonEmptyText n -> NonEmptyText n -> Bool
$c>= :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
> :: NonEmptyText n -> NonEmptyText n -> Bool
$c> :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
<= :: NonEmptyText n -> NonEmptyText n -> Bool
$c<= :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
< :: NonEmptyText n -> NonEmptyText n -> Bool
$c< :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Bool
compare :: NonEmptyText n -> NonEmptyText n -> Ordering
$ccompare :: forall (n :: Natural). NonEmptyText n -> NonEmptyText n -> Ordering
Ord, [NonEmptyText n] -> Encoding
[NonEmptyText n] -> Value
NonEmptyText n -> Encoding
NonEmptyText n -> Value
forall (n :: Natural). [NonEmptyText n] -> Encoding
forall (n :: Natural). [NonEmptyText n] -> Value
forall (n :: Natural). NonEmptyText n -> Encoding
forall (n :: Natural). NonEmptyText n -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NonEmptyText n] -> Encoding
$ctoEncodingList :: forall (n :: Natural). [NonEmptyText n] -> Encoding
toJSONList :: [NonEmptyText n] -> Value
$ctoJSONList :: forall (n :: Natural). [NonEmptyText n] -> Value
toEncoding :: NonEmptyText n -> Encoding
$ctoEncoding :: forall (n :: Natural). NonEmptyText n -> Encoding
toJSON :: NonEmptyText n -> Value
$ctoJSON :: forall (n :: Natural). NonEmptyText n -> Value
ToJSON, NonEmpty (NonEmptyText n) -> NonEmptyText n
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
forall (n :: Natural). NonEmpty (NonEmptyText n) -> NonEmptyText n
forall (n :: Natural).
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
forall (n :: Natural) b.
Integral b =>
b -> NonEmptyText n -> NonEmptyText n
forall b. Integral b => b -> NonEmptyText n -> NonEmptyText n
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> NonEmptyText n -> NonEmptyText n
$cstimes :: forall (n :: Natural) b.
Integral b =>
b -> NonEmptyText n -> NonEmptyText n
sconcat :: NonEmpty (NonEmptyText n) -> NonEmptyText n
$csconcat :: forall (n :: Natural). NonEmpty (NonEmptyText n) -> NonEmptyText n
<> :: NonEmptyText n -> NonEmptyText n -> NonEmptyText n
$c<> :: forall (n :: Natural).
NonEmptyText n -> NonEmptyText n -> NonEmptyText n
Semigroup, Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
NonEmptyText n -> Bool
NonEmptyText n -> Int
NonEmptyText n -> Int64
NonEmptyText n -> [Element (NonEmptyText n)]
NonEmptyText n -> Element (NonEmptyText n)
(Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
(Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
(Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
forall (n :: Natural).
Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
forall (n :: Natural). NonEmptyText n -> Bool
forall (n :: Natural). NonEmptyText n -> Int
forall (n :: Natural). NonEmptyText n -> Int64
forall (n :: Natural). NonEmptyText n -> [Element (NonEmptyText n)]
forall (n :: Natural). NonEmptyText n -> Element (NonEmptyText n)
forall (n :: Natural).
(Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
forall (n :: Natural).
(Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
forall (n :: Natural).
(Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
forall (n :: Natural) i.
Integral i =>
NonEmptyText n -> i -> Ordering
forall (n :: Natural) m.
Semigroup m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
forall (n :: Natural) m.
Monoid m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
forall (n :: Natural) a.
(a -> Element (NonEmptyText n) -> a) -> a -> NonEmptyText n -> a
forall (n :: Natural) b.
(Element (NonEmptyText n) -> b -> b) -> b -> NonEmptyText n -> b
forall (n :: Natural) (m :: * -> *).
Applicative m =>
NonEmptyText n -> (Element (NonEmptyText n) -> m ()) -> m ()
forall (n :: Natural) (m :: * -> *).
Applicative m =>
(Element (NonEmptyText n) -> m ()) -> NonEmptyText n -> m ()
forall (n :: Natural) (m :: * -> *) a.
Monad m =>
(a -> Element (NonEmptyText n) -> m a)
-> a -> NonEmptyText n -> m a
forall (n :: Natural) (f :: * -> *) b.
Applicative f =>
NonEmptyText n -> (Element (NonEmptyText n) -> f b) -> f ()
forall (n :: Natural) (f :: * -> *) b.
Applicative f =>
(Element (NonEmptyText n) -> f b) -> NonEmptyText n -> f ()
forall i. Integral i => NonEmptyText n -> i -> Ordering
forall m.
Semigroup m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
forall m.
Monoid m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
forall a.
(a -> Element (NonEmptyText n) -> a) -> a -> NonEmptyText n -> a
forall b.
(Element (NonEmptyText n) -> b -> b) -> b -> NonEmptyText n -> b
forall mono.
(forall m. Monoid m => (Element mono -> m) -> mono -> m)
-> (forall b. (Element mono -> b -> b) -> b -> mono -> b)
-> (forall a. (a -> Element mono -> a) -> a -> mono -> a)
-> (mono -> [Element mono])
-> ((Element mono -> Bool) -> mono -> Bool)
-> ((Element mono -> Bool) -> mono -> Bool)
-> (mono -> Bool)
-> (mono -> Int)
-> (mono -> Int64)
-> (forall i. Integral i => mono -> i -> Ordering)
-> (forall (f :: * -> *) b.
    Applicative f =>
    (Element mono -> f b) -> mono -> f ())
-> (forall (f :: * -> *) b.
    Applicative f =>
    mono -> (Element mono -> f b) -> f ())
-> (forall (m :: * -> *).
    Applicative m =>
    (Element mono -> m ()) -> mono -> m ())
-> (forall (m :: * -> *).
    Applicative m =>
    mono -> (Element mono -> m ()) -> m ())
-> (forall (m :: * -> *) a.
    Monad m =>
    (a -> Element mono -> m a) -> a -> mono -> m a)
-> (forall m. Semigroup m => (Element mono -> m) -> mono -> m)
-> ((Element mono -> Element mono -> Element mono)
    -> mono -> Element mono)
-> ((Element mono -> Element mono -> Element mono)
    -> mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> (mono -> Element mono)
-> ((Element mono -> Element mono -> Ordering)
    -> mono -> Element mono)
-> ((Element mono -> Element mono -> Ordering)
    -> mono -> Element mono)
-> (Eq (Element mono) => Element mono -> mono -> Bool)
-> (Eq (Element mono) => Element mono -> mono -> Bool)
-> MonoFoldable mono
forall (m :: * -> *).
Applicative m =>
NonEmptyText n -> (Element (NonEmptyText n) -> m ()) -> m ()
forall (m :: * -> *).
Applicative m =>
(Element (NonEmptyText n) -> m ()) -> NonEmptyText n -> m ()
forall (m :: * -> *) a.
Monad m =>
(a -> Element (NonEmptyText n) -> m a)
-> a -> NonEmptyText n -> m a
forall (f :: * -> *) b.
Applicative f =>
NonEmptyText n -> (Element (NonEmptyText n) -> f b) -> f ()
forall (f :: * -> *) b.
Applicative f =>
(Element (NonEmptyText n) -> f b) -> NonEmptyText n -> f ()
onotElem :: Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
$conotElem :: forall (n :: Natural).
Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
oelem :: Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
$coelem :: forall (n :: Natural).
Eq (Element (NonEmptyText n)) =>
Element (NonEmptyText n) -> NonEmptyText n -> Bool
minimumByEx :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
$cminimumByEx :: forall (n :: Natural).
(Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
maximumByEx :: (Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
$cmaximumByEx :: forall (n :: Natural).
(Element (NonEmptyText n) -> Element (NonEmptyText n) -> Ordering)
-> NonEmptyText n -> Element (NonEmptyText n)
unsafeLast :: NonEmptyText n -> Element (NonEmptyText n)
$cunsafeLast :: forall (n :: Natural). NonEmptyText n -> Element (NonEmptyText n)
unsafeHead :: NonEmptyText n -> Element (NonEmptyText n)
$cunsafeHead :: forall (n :: Natural). NonEmptyText n -> Element (NonEmptyText n)
lastEx :: NonEmptyText n -> Element (NonEmptyText n)
$clastEx :: forall (n :: Natural). NonEmptyText n -> Element (NonEmptyText n)
headEx :: NonEmptyText n -> Element (NonEmptyText n)
$cheadEx :: forall (n :: Natural). NonEmptyText n -> Element (NonEmptyText n)
ofoldl1Ex' :: (Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
$cofoldl1Ex' :: forall (n :: Natural).
(Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
ofoldr1Ex :: (Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
$cofoldr1Ex :: forall (n :: Natural).
(Element (NonEmptyText n)
 -> Element (NonEmptyText n) -> Element (NonEmptyText n))
-> NonEmptyText n -> Element (NonEmptyText n)
ofoldMap1Ex :: forall m.
Semigroup m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
$cofoldMap1Ex :: forall (n :: Natural) m.
Semigroup m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
ofoldlM :: forall (m :: * -> *) a.
Monad m =>
(a -> Element (NonEmptyText n) -> m a)
-> a -> NonEmptyText n -> m a
$cofoldlM :: forall (n :: Natural) (m :: * -> *) a.
Monad m =>
(a -> Element (NonEmptyText n) -> m a)
-> a -> NonEmptyText n -> m a
oforM_ :: forall (m :: * -> *).
Applicative m =>
NonEmptyText n -> (Element (NonEmptyText n) -> m ()) -> m ()
$coforM_ :: forall (n :: Natural) (m :: * -> *).
Applicative m =>
NonEmptyText n -> (Element (NonEmptyText n) -> m ()) -> m ()
omapM_ :: forall (m :: * -> *).
Applicative m =>
(Element (NonEmptyText n) -> m ()) -> NonEmptyText n -> m ()
$comapM_ :: forall (n :: Natural) (m :: * -> *).
Applicative m =>
(Element (NonEmptyText n) -> m ()) -> NonEmptyText n -> m ()
ofor_ :: forall (f :: * -> *) b.
Applicative f =>
NonEmptyText n -> (Element (NonEmptyText n) -> f b) -> f ()
$cofor_ :: forall (n :: Natural) (f :: * -> *) b.
Applicative f =>
NonEmptyText n -> (Element (NonEmptyText n) -> f b) -> f ()
otraverse_ :: forall (f :: * -> *) b.
Applicative f =>
(Element (NonEmptyText n) -> f b) -> NonEmptyText n -> f ()
$cotraverse_ :: forall (n :: Natural) (f :: * -> *) b.
Applicative f =>
(Element (NonEmptyText n) -> f b) -> NonEmptyText n -> f ()
ocompareLength :: forall i. Integral i => NonEmptyText n -> i -> Ordering
$cocompareLength :: forall (n :: Natural) i.
Integral i =>
NonEmptyText n -> i -> Ordering
olength64 :: NonEmptyText n -> Int64
$colength64 :: forall (n :: Natural). NonEmptyText n -> Int64
olength :: NonEmptyText n -> Int
$colength :: forall (n :: Natural). NonEmptyText n -> Int
onull :: NonEmptyText n -> Bool
$conull :: forall (n :: Natural). NonEmptyText n -> Bool
oany :: (Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
$coany :: forall (n :: Natural).
(Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
oall :: (Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
$coall :: forall (n :: Natural).
(Element (NonEmptyText n) -> Bool) -> NonEmptyText n -> Bool
otoList :: NonEmptyText n -> [Element (NonEmptyText n)]
$cotoList :: forall (n :: Natural). NonEmptyText n -> [Element (NonEmptyText n)]
ofoldl' :: forall a.
(a -> Element (NonEmptyText n) -> a) -> a -> NonEmptyText n -> a
$cofoldl' :: forall (n :: Natural) a.
(a -> Element (NonEmptyText n) -> a) -> a -> NonEmptyText n -> a
ofoldr :: forall b.
(Element (NonEmptyText n) -> b -> b) -> b -> NonEmptyText n -> b
$cofoldr :: forall (n :: Natural) b.
(Element (NonEmptyText n) -> b -> b) -> b -> NonEmptyText n -> b
ofoldMap :: forall m.
Monoid m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
$cofoldMap :: forall (n :: Natural) m.
Monoid m =>
(Element (NonEmptyText n) -> m) -> NonEmptyText n -> m
MonoFoldable)

type instance Element (NonEmptyText _n) = Char

instance (KnownNat n, 1 <= n) => FromJSON (NonEmptyText n) where
  parseJSON :: Value -> Parser (NonEmptyText n)
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"NonEmptyText" forall a b. (a -> b) -> a -> b
$ \Text
t -> do
    forall {m :: * -> *}. MonadFail m => Text -> m ()
performInboundValidations Text
t
    case forall (n :: Natural).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyText Text
t of
      Maybe (NonEmptyText n)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Data/StringVariants/NonEmptyText.hs: invalid NonEmptyText: " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
      Just NonEmptyText n
nonEmptyText -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmptyText n
nonEmptyText
    where
      -- These validations are performed at the edge of the system rather than in
      -- mkNonEmptyText because there may be cases where legacy NonEmptyText is
      -- stored in the database that fits one of these situations.
      --
      -- However, we don't want new stuff to send junk data, so we use this FromJSON
      -- instance to validate at the edge.
      performInboundValidations :: Text -> m ()
performInboundValidations Text
t = do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
textHasNoMeaningfulContent Text
t) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
            String
"Data/StringVariants/NonEmptyText.hs: NonEmptyText has no meaningful content in the field: " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
'\NUL') Text
t) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
            String
"Data/StringVariants/NonEmptyText.hs: NonEmptyText has a \\NUL byte in its contents: " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
t

-- Could add more instances of this (for lazy text, bytestrings, etc) if we think we need them.
instance ConvertibleStrings (NonEmptyText n) Text where
  convertString :: NonEmptyText n -> Text
convertString (NonEmptyText Text
t) = Text
t

instance ConvertibleStrings (NonEmptyText n) String where
  convertString :: NonEmptyText n -> String
convertString (NonEmptyText Text
t) = forall a b. ConvertibleStrings a b => a -> b
cs Text
t

instance ConvertibleStrings (NonEmptyText n) ByteString where
  convertString :: NonEmptyText n -> ByteString
convertString (NonEmptyText Text
t) = forall a b. ConvertibleStrings a b => a -> b
cs Text
t

instance (KnownNat n, 1 <= n) => Arbitrary (NonEmptyText n) where
  arbitrary :: Gen (NonEmptyText n)
arbitrary =
    forall (n :: Natural). Text -> NonEmptyText n
NonEmptyText @n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
      Int
size <- (Int, Int) -> Gen Int
chooseInt (Int
1, forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)) forall a. Num a => a -> a -> a
- Int
1)
      -- Mostly alphanumeric characters, all human readable
      String
str <- forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
Index seq -> m (Element seq) -> m seq
replicateM Int
size forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Gen a
elements [Char
'0' .. Char
'z']
      pure $ String -> Text
T.pack String
str

mkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
mkNonEmptyText :: forall (n :: Natural).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyText Text
t
  | Text -> Int -> Ordering
T.compareLength Text
stripped (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)) forall a. Eq a => a -> a -> Bool
== Ordering
GT = forall a. Maybe a
Nothing
  | Text -> Bool
textIsWhitespace Text
stripped = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall (n :: Natural). Text -> NonEmptyText n
NonEmptyText Text
stripped)
  where
    stripped :: Text
stripped = (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\NUL') forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t

mkNonEmptyTextWithTruncate :: forall n. (KnownNat n, 1 <= n) => Text -> Maybe (NonEmptyText n)
mkNonEmptyTextWithTruncate :: forall (n :: Natural).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyTextWithTruncate Text
t
  | Text -> Bool
textIsWhitespace Text
stripped = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall (n :: Natural). Text -> NonEmptyText n
NonEmptyText forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) (proxy :: Natural -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)) Text
stripped)
  where
    stripped :: Text
stripped = (Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\NUL') forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart Text
t

-- | Make a NonEmptyText when you can manually verify the length
unsafeMkNonEmptyText :: forall n. (KnownNat n, 1 <= n) => Text -> NonEmptyText n
unsafeMkNonEmptyText :: forall (n :: Natural).
(KnownNat n, 1 <= n) =>
Text -> NonEmptyText n
unsafeMkNonEmptyText = forall (n :: Natural). Text -> NonEmptyText n
NonEmptyText

-- | Converts a 'NonEmptyText' to a wider NonEmptyText
widen :: (1 <= n, n <= m) => NonEmptyText n -> NonEmptyText m
widen :: forall (n :: Natural) (m :: Natural).
(1 <= n, n <= m) =>
NonEmptyText n -> NonEmptyText m
widen = coerce :: forall a b. Coercible a b => a -> b
coerce

compileNonEmptyTextKnownLength :: QuasiQuoter
compileNonEmptyTextKnownLength :: QuasiQuoter
compileNonEmptyTextKnownLength =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
s -> do
        let txt :: Text
txt = String -> Text
T.pack String
s
        if Text -> Bool
textHasNoMeaningfulContent Text
txt
          then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid NonEmptyText. Must have at least one non-whitespace, non-control character."
          else [|NonEmptyText $(lift txt) :: NonEmptyText $(pure $ LitT $ NumTyLit $ fromIntegral $ T.length txt)|]
    , quotePat :: String -> Q Pat
quotePat = forall a. HasCallStack => String -> a
error String
"Known-length NonEmptyText is not currently supported as a pattern"
    , quoteDec :: String -> Q [Dec]
quoteDec = forall a. HasCallStack => String -> a
error String
"NonEmptyText is not supported at top-level"
    , quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => String -> a
error String
"NonEmptyText is not supported as a type"
    }