module Data.StringVariants.Util (natOfLength, useNat, textIsTooLong, textIsWhitespace, textHasNoMeaningfulContent) where
import GHC.TypeLits (KnownNat, Nat, SomeNat (..), someNatVal)
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 :: Text -> Int -> Bool
textIsTooLong Text
t Int
n = Text -> Int
T.length (Int -> Text -> Text
T.take (Int
n forall a. Num a => a -> a -> a
+ Int
1) Text
t) forall a. Ord a => a -> a -> Bool
>= (Int
n forall a. Num a => a -> a -> a
+ Int
1)

textIsWhitespace :: Text -> Bool
textIsWhitespace :: Text -> Bool
textIsWhitespace = (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace

textHasNoMeaningfulContent :: Text -> Bool
textHasNoMeaningfulContent :: Text -> Bool
textHasNoMeaningfulContent = (Char -> Bool) -> Text -> Bool
T.all (\Char
c -> Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c)


natOfLength :: proxy (n :: Nat) -> f (other n) -> f (other n)
natOfLength :: forall {k} (proxy :: Nat -> *) (n :: Nat) (f :: k -> *)
       (other :: Nat -> k).
proxy n -> f (other n) -> f (other n)
natOfLength proxy n
_ = forall a. a -> a
id

useNat :: Integer -> (forall n proxy. KnownNat n => proxy n -> x) -> x
useNat :: forall x.
Integer
-> (forall (n :: Nat) (proxy :: Nat -> *).
    KnownNat n =>
    proxy n -> x)
-> x
useNat Integer
n forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> x
f = case Integer -> Maybe SomeNat
someNatVal Integer
n of
  Maybe SomeNat
Nothing -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show Integer
n forall a. [a] -> [a] -> [a]
++ [Char]
" isn't a valid Nat")
  Just (SomeNat Proxy n
p) -> forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> x
f Proxy n
p