{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | NonEmptyText: Text that is known not to be either the empty string, or pure
--   whitespace.

module Data.StringVariants.NonEmptyText
  ( -- * Non empty text
    NonEmptyText,
    type (<=),

    -- * Construction
    mkNonEmptyText,
    mkNonEmptyTextWithTruncate,
    literalNonEmptyText,
    unsafeMkNonEmptyText,
    nonEmptyTextToText,
    compileNonEmptyText,
    compileNonEmptyTextKnownLength,
    convertEmptyTextToNothing,

    -- * Conversion
    widen,

    -- * Functions
    takeNonEmptyText,
    takeNonEmptyTextEnd,
    chunksOfNonEmptyText,
    filterNonEmptyText,
    (<>|),
    concatWithSpace,

    -- * Conversions between 'Refined' and 'NonEmptyText'.
    ContainsNonWhitespaceCharacters (..),
    exactLengthRefinedToRange,
    nonEmptyTextFromRefined,
    refinedFromNonEmptyText,
  )
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, KnownSymbol, Symbol, Nat, natVal, symbolVal, type (+), type (<=))
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax (Lift (..))
import Refined
import Refined.Unsafe (reallyUnsafeRefine)
import Prelude

compileNonEmptyText :: Integer -> QuasiQuoter
compileNonEmptyText :: Integer -> QuasiQuoter
compileNonEmptyText Integer
n =
  QuasiQuoter
    { quoteExp :: [Char] -> Q Exp
quoteExp = [Char] -> Q Exp
compileNonEmptyText'
    , quotePat :: [Char] -> Q Pat
quotePat = forall a. HasCallStack => [Char] -> a
error [Char]
"NonEmptyText is not a pattern; use nonEmptyTextToText instead"
    , quoteDec :: [Char] -> Q [Dec]
quoteDec = forall a. HasCallStack => [Char] -> a
error [Char]
"NonEmptyText is not supported at top-level"
    , quoteType :: [Char] -> Q Type
quoteType = forall a. HasCallStack => [Char] -> a
error [Char]
"NonEmptyText is not supported as a type"
    }
  where
    compileNonEmptyText' :: String -> Q Exp
    compileNonEmptyText' :: [Char] -> Q Exp
compileNonEmptyText' [Char]
s = forall a.
Integer
-> a
-> (forall (n :: Nat) (proxy :: Nat -> *).
    (KnownNat n, 1 <= n) =>
    proxy n -> a)
-> a
usePositiveNat Integer
n Q Exp
errorMessage forall a b. (a -> b) -> a -> b
$ \(proxy n
_ :: proxy n) ->
      case forall (n :: Nat).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyText @n ([Char] -> Text
T.pack [Char]
s) of
        Just NonEmptyText n
txt -> [|$(lift txt) :: NonEmptyText $(pure $ LitT $ NumTyLit n)|]
        Maybe (NonEmptyText n)
Nothing -> Q Exp
errorMessage
      where
        errorMessage :: Q Exp
errorMessage = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid NonEmptyText. Needs to be < " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Integer
n forall a. Num a => a -> a -> a
+ Integer
1) forall a. [a] -> [a] -> [a]
++ [Char]
" characters, and not entirely whitespace: " forall a. [a] -> [a] -> [a]
++ [Char]
s

literalNonEmptyText :: forall (s :: Symbol) (n :: Nat). (KnownSymbol s, KnownNat n, SymbolNonEmpty s, SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) => NonEmptyText n
literalNonEmptyText :: forall (s :: Symbol) (n :: Nat).
(KnownSymbol s, KnownNat n, SymbolNonEmpty s,
 SymbolWithNoSpaceAround s, SymbolNoLongerThan s n) =>
NonEmptyText n
literalNonEmptyText = forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText ([Char] -> Text
T.pack (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
Proxy @s)))

convertEmptyTextToNothing :: Text -> Maybe Text
convertEmptyTextToNothing :: Text -> Maybe Text
convertEmptyTextToNothing Text
t
  | Text -> Bool
textIsWhitespace Text
t = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just Text
t

nonEmptyTextToText :: NonEmptyText n -> Text
nonEmptyTextToText :: forall (n :: Nat). NonEmptyText n -> Text
nonEmptyTextToText (NonEmptyText Text
t) = Text
t

-- | 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.
filterNonEmptyText :: (KnownNat n, 1 <= n) => (Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n)
filterNonEmptyText :: forall (n :: Nat).
(KnownNat n, 1 <= n) =>
(Char -> Bool) -> NonEmptyText n -> Maybe (NonEmptyText n)
filterNonEmptyText Char -> Bool
f (NonEmptyText Text
t) = forall (n :: Nat).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyText ((Char -> Bool) -> Text -> Text
T.filter Char -> Bool
f Text
t)

-- | Narrows the maximum length, dropping any remaining trailing characters.
takeNonEmptyText :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n
takeNonEmptyText :: forall (m :: Nat) (n :: Nat).
(KnownNat m, KnownNat n, 1 <= n, n <= m) =>
NonEmptyText m -> NonEmptyText n
takeNonEmptyText (NonEmptyText Text
t) =
  if Int
m forall a. Eq a => a -> a -> Bool
== Int
n
    then forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText Text
t
    -- when the input is stripped, taking from it is guaranteed to be not empty
    else forall (n :: Nat). 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 Int
n Text
t
  where
    m :: Int
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @m)
    n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)

-- | Narrows the maximum length, dropping any prefix remaining characters.
takeNonEmptyTextEnd :: forall m n. (KnownNat m, KnownNat n, 1 <= n, n <= m) => NonEmptyText m -> NonEmptyText n
takeNonEmptyTextEnd :: forall (m :: Nat) (n :: Nat).
(KnownNat m, KnownNat n, 1 <= n, n <= m) =>
NonEmptyText m -> NonEmptyText n
takeNonEmptyTextEnd (NonEmptyText Text
t) =
  if Int
m forall a. Eq a => a -> a -> Bool
== Int
n
    then forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText Text
t
    -- when the input is stripped, taking from it is guaranteed to be not empty
    else forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripStart forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.takeEnd Int
n Text
t
  where
    m :: Int
m = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @m)
    n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @n)

-- | /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.
chunksOfNonEmptyText ::
  forall chunkSize totalSize.
  (KnownNat chunkSize, KnownNat totalSize, chunkSize <= totalSize, 1 <= chunkSize) =>
  NonEmptyText totalSize ->
  [NonEmptyText chunkSize]
chunksOfNonEmptyText :: forall (chunkSize :: Nat) (totalSize :: Nat).
(KnownNat chunkSize, KnownNat totalSize, chunkSize <= totalSize,
 1 <= chunkSize) =>
NonEmptyText totalSize -> [NonEmptyText chunkSize]
chunksOfNonEmptyText (NonEmptyText Text
t) =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (n :: Nat).
(KnownNat n, 1 <= n) =>
Text -> Maybe (NonEmptyText n)
mkNonEmptyText (Int -> Text -> [Text]
T.chunksOf Int
chunkSize Text
t)
  where
    chunkSize :: Int
chunkSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy @chunkSize)

-- | 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
(<>|) :: NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m)
(NonEmptyText Text
l) <>| :: forall (n :: Nat) (m :: Nat).
NonEmptyText n -> NonEmptyText m -> NonEmptyText (n + m)
<>| (NonEmptyText Text
r) = forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText (Text
l forall a. Semigroup a => a -> a -> a
<> Text
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 :: forall (n :: Nat) (m :: Nat).
NonEmptyText n -> NonEmptyText m -> NonEmptyText ((n + m) + 1)
concatWithSpace (NonEmptyText Text
l)  (NonEmptyText Text
r) = forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText (Text
l forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
r)

-- Refinery

data ContainsNonWhitespaceCharacters = ContainsNonWhitespaceCharacters
  deriving stock (forall x.
Rep ContainsNonWhitespaceCharacters x
-> ContainsNonWhitespaceCharacters
forall x.
ContainsNonWhitespaceCharacters
-> Rep ContainsNonWhitespaceCharacters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ContainsNonWhitespaceCharacters x
-> ContainsNonWhitespaceCharacters
$cfrom :: forall x.
ContainsNonWhitespaceCharacters
-> Rep ContainsNonWhitespaceCharacters x
Generic)

instance Predicate ContainsNonWhitespaceCharacters Text where
  validate :: Proxy ContainsNonWhitespaceCharacters
-> Text -> Maybe RefineException
validate Proxy ContainsNonWhitespaceCharacters
p Text
txt
    | Text -> Bool
textHasNoMeaningfulContent Text
txt = TypeRep -> Text -> Maybe RefineException
throwRefineOtherException (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy ContainsNonWhitespaceCharacters
p) Text
"All characters in Text input are whitespace or control characters"
    | Bool
otherwise = forall a. Maybe a
Nothing

exactLengthRefinedToRange :: Refined (ContainsNonWhitespaceCharacters && SizeEqualTo n) Text -> NonEmptyText n
exactLengthRefinedToRange :: forall (n :: Nat).
Refined (ContainsNonWhitespaceCharacters && SizeEqualTo n) Text
-> NonEmptyText n
exactLengthRefinedToRange = forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) x. Refined p x -> x
unrefine

nonEmptyTextFromRefined :: Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text -> NonEmptyText n
nonEmptyTextFromRefined :: forall (n :: Nat).
Refined
  (ContainsNonWhitespaceCharacters
   && (SizeLessThan n || SizeEqualTo n))
  Text
-> NonEmptyText n
nonEmptyTextFromRefined = forall (n :: Nat). Text -> NonEmptyText n
NonEmptyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (p :: k) x. Refined p x -> x
unrefine

refinedFromNonEmptyText :: NonEmptyText n -> Refined (ContainsNonWhitespaceCharacters && (SizeLessThan n || SizeEqualTo n)) Text
refinedFromNonEmptyText :: forall (n :: Nat).
NonEmptyText n
-> Refined
     (ContainsNonWhitespaceCharacters
      && (SizeLessThan n || SizeEqualTo n))
     Text
refinedFromNonEmptyText = forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). NonEmptyText n -> Text
nonEmptyTextToText