-- | Predicates for 'Foldable'.
--
-- @since 0.1.0.0
module Refined.Extras.Predicates.Foldable
  ( -- * Elements
    All,
    Any,
    None,
  )
where

import Control.Applicative (Alternative ((<|>)))
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TEnc
import Data.Text.Encoding.Error qualified as TEncError
import Data.Text.Lazy qualified as LT
import Data.Typeable (Proxy (Proxy))
import Data.Typeable qualified as Ty
import Data.Word (Word8)
import GHC.Generics (Generic)
import Refined
  ( Not,
    Predicate (validate),
    RefineException (RefineOtherException),
  )

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Refined (NonZero, Negative)
-- >>> import Refined.Extras.Utils (showRefineException)

-- | Predicate for all elements satisfying some predicate.
--
-- ==== __Examples__
-- >>> validate @(All NonZero) Proxy [1..5]
-- Nothing
--
-- >>> showRefineException <$> validate @(All NonZero) Proxy [0..5]
-- Just "RefineOtherException (NotEqualTo 0) \"Value does equal 0\""
--
-- @since 0.1.0.0
type All :: Type -> Type
data All p
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. All p -> Rep (All p) x)
-> (forall x. Rep (All p) x -> All p) -> Generic (All p)
forall x. Rep (All p) x -> All p
forall x. All p -> Rep (All p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (All p) x -> All p
forall p x. All p -> Rep (All p) x
$cfrom :: forall p x. All p -> Rep (All p) x
from :: forall x. All p -> Rep (All p) x
$cto :: forall p x. Rep (All p) x -> All p
to :: forall x. Rep (All p) x -> All p
Generic
    )

-- | @since 0.1.0.0
instance (Foldable f, Predicate p a) => Predicate (All p) (f a) where
  validate :: Proxy (All p) -> f a -> Maybe RefineException
validate Proxy (All p)
_ = (a -> Maybe RefineException) -> f a -> Maybe RefineException
forall (f :: * -> *) a b.
Foldable f =>
(a -> Maybe b) -> f a -> Maybe b
allFoldableSatisfies (forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
forall p x. Predicate p x => Proxy p -> x -> Maybe RefineException
validate @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)

-- | @since 0.1.0.0
instance (Predicate p Char) => Predicate (All p) Text where
  validate :: Proxy (All p) -> Text -> Maybe RefineException
validate Proxy (All p)
_ = (Char -> Maybe RefineException) -> Text -> Maybe RefineException
forall b. (Char -> Maybe b) -> Text -> Maybe b
allTextSatisfies (forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
forall p x. Predicate p x => Proxy p -> x -> Maybe RefineException
validate @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)

-- | @since 0.1.0.0
instance (Predicate p Char) => Predicate (All p) LT.Text where
  validate :: Proxy (All p) -> Text -> Maybe RefineException
validate Proxy (All p)
_ = (Char -> Maybe RefineException) -> Text -> Maybe RefineException
forall b. (Char -> Maybe b) -> Text -> Maybe b
allLazyTextSatisfies (forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
forall p x. Predicate p x => Proxy p -> x -> Maybe RefineException
validate @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)

-- | @since 0.1.0.0
instance (Predicate p Word8) => Predicate (All p) ByteString where
  validate :: Proxy (All p) -> ByteString -> Maybe RefineException
validate Proxy (All p)
_ = (Word8 -> Maybe RefineException)
-> ByteString -> Maybe RefineException
forall a. (Word8 -> Maybe a) -> ByteString -> Maybe a
allByteStringSatisfies (forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
forall p x. Predicate p x => Proxy p -> x -> Maybe RefineException
validate @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)

-- | @since 0.1.0.0
instance (Predicate p Word8) => Predicate (All p) BSL.ByteString where
  validate :: Proxy (All p) -> ByteString -> Maybe RefineException
validate Proxy (All p)
_ = (Word8 -> Maybe RefineException)
-> ByteString -> Maybe RefineException
forall a. (Word8 -> Maybe a) -> ByteString -> Maybe a
allLazyByteStringSatisfies (forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
forall p x. Predicate p x => Proxy p -> x -> Maybe RefineException
validate @p Proxy p
forall {k} (t :: k). Proxy t
Proxy)

-- | Predicate for any element satisfying some predicate.
--
-- ==== __Examples__
-- >>> validate @(Any NonZero) Proxy [0,0,0,4]
-- Nothing
--
-- >>> showRefineException <$> validate @(Any NonZero) Proxy [0,0,0]
-- Just "RefineOtherException (NotEqualTo 0) \"No element satisfied the predicate\""
--
-- @since 0.1.0.0
type Any :: Type -> Type
data Any p
  deriving stock
    ( -- | @since 0.1.0.0
      (forall x. Any p -> Rep (Any p) x)
-> (forall x. Rep (Any p) x -> Any p) -> Generic (Any p)
forall x. Rep (Any p) x -> Any p
forall x. Any p -> Rep (Any p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (Any p) x -> Any p
forall p x. Any p -> Rep (Any p) x
$cfrom :: forall p x. Any p -> Rep (Any p) x
from :: forall x. Any p -> Rep (Any p) x
$cto :: forall p x. Rep (Any p) x -> Any p
to :: forall x. Rep (Any p) x -> Any p
Generic
    )

-- | @since 0.1.0.0
instance (Foldable f, Predicate p a) => Predicate (Any p) (f a) where
  validate :: Proxy (Any p) -> f a -> Maybe RefineException
validate Proxy (Any p)
_ = RefineException
-> (a -> Maybe RefineException) -> f a -> Maybe RefineException
forall (f :: * -> *) b a.
Foldable f =>
b -> (a -> Maybe b) -> f a -> Maybe b
anyFoldableSatisfies RefineException
err (Proxy p -> a -> Maybe RefineException
forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
validate Proxy p
proxy)
    where
      proxy :: Proxy p
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p
      err :: RefineException
err = TypeRep -> Text -> RefineException
RefineOtherException (Proxy p -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy p
proxy) Text
"No element satisfied the predicate"

-- | @since 0.1.0.0
instance (Predicate p Char) => Predicate (Any p) Text where
  validate :: Proxy (Any p) -> Text -> Maybe RefineException
validate Proxy (Any p)
_ Text
txt = RefineException
-> (Char -> Maybe RefineException) -> Text -> Maybe RefineException
forall b. b -> (Char -> Maybe b) -> Text -> Maybe b
anyTextSatisfies RefineException
err (Proxy p -> Char -> Maybe RefineException
forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
validate Proxy p
proxy) Text
txt
    where
      proxy :: Proxy p
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p
      msg :: Text
msg = Text
"No element satisfied the predicate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
      err :: RefineException
err = TypeRep -> Text -> RefineException
RefineOtherException (Proxy p -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy p
proxy) Text
msg

-- | @since 0.1.0.0
instance (Predicate p Char) => Predicate (Any p) LT.Text where
  validate :: Proxy (Any p) -> Text -> Maybe RefineException
validate Proxy (Any p)
_ Text
txt = RefineException
-> (Char -> Maybe RefineException) -> Text -> Maybe RefineException
forall b. b -> (Char -> Maybe b) -> Text -> Maybe b
anyLazyTextSatisfies RefineException
err (Proxy p -> Char -> Maybe RefineException
forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
validate Proxy p
proxy) Text
txt
    where
      proxy :: Proxy p
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p
      msg :: Text
msg = Text
"No element satisfied the predicate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
      err :: RefineException
err = TypeRep -> Text -> RefineException
RefineOtherException (Proxy p -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy p
proxy) (Text -> Text
LT.toStrict Text
msg)

-- | @since 0.1.0.0
instance (Predicate p Word8) => Predicate (Any p) ByteString where
  validate :: Proxy (Any p) -> ByteString -> Maybe RefineException
validate Proxy (Any p)
_ ByteString
bs = RefineException
-> (Word8 -> Maybe RefineException)
-> ByteString
-> Maybe RefineException
forall b. b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
anyByteStringSatisfies RefineException
err (Proxy p -> Word8 -> Maybe RefineException
forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
validate Proxy p
proxy) ByteString
bs
    where
      proxy :: Proxy p
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p
      prefix :: Text
prefix = Text
"No element satisfied the predicate: "
      err :: RefineException
err = TypeRep -> Text -> RefineException
RefineOtherException (Proxy p -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy p
proxy) (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
      msg :: Text
msg = ByteString -> Text
decodeUtf8Lenient ByteString
bs

-- | @since 0.1.0.0
instance (Predicate p Word8) => Predicate (Any p) BSL.ByteString where
  validate :: Proxy (Any p) -> ByteString -> Maybe RefineException
validate Proxy (Any p)
_ ByteString
bs = RefineException
-> (Word8 -> Maybe RefineException)
-> ByteString
-> Maybe RefineException
forall b. b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
anyLazyByteStringSatisfies RefineException
err (Proxy p -> Word8 -> Maybe RefineException
forall {k} (p :: k) x.
Predicate p x =>
Proxy p -> x -> Maybe RefineException
validate Proxy p
proxy) ByteString
bs
    where
      proxy :: Proxy p
proxy = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @p
      prefix :: Text
prefix = Text
"No element satisfied the predicate: "
      err :: RefineException
err = TypeRep -> Text -> RefineException
RefineOtherException (Proxy p -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Ty.typeRep Proxy p
proxy) (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg)
      msg :: Text
msg = ByteString -> Text
decodeUtf8Lenient (ByteString -> ByteString
BSL.toStrict ByteString
bs)

-- | Predicate for no elements satisfying a predicate.
--
-- ==== __Examples__
-- >>> validate @(None Negative) Proxy [3,4,5]
-- Nothing
--
-- >>> showRefineException <$> validate @(None Negative) Proxy [3,-1,2,5]
-- Just "RefineNotException (Not * (Any (LessThan 0)))"
--
-- @since 0.1.0.0
type None :: Type -> Type
type None p = Not (Any p)

allFoldableSatisfies :: (Foldable f) => (a -> Maybe b) -> f a -> Maybe b
allFoldableSatisfies :: forall (f :: * -> *) a b.
Foldable f =>
(a -> Maybe b) -> f a -> Maybe b
allFoldableSatisfies = ((a -> Maybe b -> Maybe b) -> Maybe b -> f a -> Maybe b)
-> (a -> Maybe b) -> f a -> Maybe b
forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (a -> Maybe b -> Maybe b) -> Maybe b -> f a -> Maybe b
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr

allTextSatisfies :: (Char -> Maybe b) -> Text -> Maybe b
allTextSatisfies :: forall b. (Char -> Maybe b) -> Text -> Maybe b
allTextSatisfies = ((Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b)
-> (Char -> Maybe b) -> Text -> Maybe b
forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr

allLazyTextSatisfies :: (Char -> Maybe b) -> LT.Text -> Maybe b
allLazyTextSatisfies :: forall b. (Char -> Maybe b) -> Text -> Maybe b
allLazyTextSatisfies = ((Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b)
-> (Char -> Maybe b) -> Text -> Maybe b
forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b
forall a. (Char -> a -> a) -> a -> Text -> a
LT.foldr

allByteStringSatisfies :: (Word8 -> Maybe a) -> ByteString -> Maybe a
allByteStringSatisfies :: forall a. (Word8 -> Maybe a) -> ByteString -> Maybe a
allByteStringSatisfies = ((Word8 -> Maybe a -> Maybe a) -> Maybe a -> ByteString -> Maybe a)
-> (Word8 -> Maybe a) -> ByteString -> Maybe a
forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (Word8 -> Maybe a -> Maybe a) -> Maybe a -> ByteString -> Maybe a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr

allLazyByteStringSatisfies :: (Word8 -> Maybe a) -> BSL.ByteString -> Maybe a
allLazyByteStringSatisfies :: forall a. (Word8 -> Maybe a) -> ByteString -> Maybe a
allLazyByteStringSatisfies = ((Word8 -> Maybe a -> Maybe a) -> Maybe a -> ByteString -> Maybe a)
-> (Word8 -> Maybe a) -> ByteString -> Maybe a
forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (Word8 -> Maybe a -> Maybe a) -> Maybe a -> ByteString -> Maybe a
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BSL.foldr

allSatisfies :: ((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies :: forall a b c d.
((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> (a -> Maybe b) -> d
allSatisfies (a -> Maybe b -> Maybe b) -> Maybe c -> d
foldFn a -> Maybe b
testPred = (a -> Maybe b -> Maybe b) -> Maybe c -> d
foldFn (\a
x Maybe b
acc -> a -> Maybe b
testPred a
x Maybe b -> Maybe b -> Maybe b
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe b
acc) Maybe c
forall a. Maybe a
Nothing

anyFoldableSatisfies :: (Foldable f) => b -> (a -> Maybe b) -> f a -> Maybe b
anyFoldableSatisfies :: forall (f :: * -> *) b a.
Foldable f =>
b -> (a -> Maybe b) -> f a -> Maybe b
anyFoldableSatisfies = ((a -> Maybe b -> Maybe b) -> Maybe b -> f a -> Maybe b)
-> b -> (a -> Maybe b) -> f a -> Maybe b
forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (a -> Maybe b -> Maybe b) -> Maybe b -> f a -> Maybe b
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr

anyTextSatisfies :: b -> (Char -> Maybe b) -> Text -> Maybe b
anyTextSatisfies :: forall b. b -> (Char -> Maybe b) -> Text -> Maybe b
anyTextSatisfies = ((Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b)
-> b -> (Char -> Maybe b) -> Text -> Maybe b
forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr

anyLazyTextSatisfies :: b -> (Char -> Maybe b) -> LT.Text -> Maybe b
anyLazyTextSatisfies :: forall b. b -> (Char -> Maybe b) -> Text -> Maybe b
anyLazyTextSatisfies = ((Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b)
-> b -> (Char -> Maybe b) -> Text -> Maybe b
forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (Char -> Maybe b -> Maybe b) -> Maybe b -> Text -> Maybe b
forall a. (Char -> a -> a) -> a -> Text -> a
LT.foldr

anyByteStringSatisfies :: b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
anyByteStringSatisfies :: forall b. b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
anyByteStringSatisfies = ((Word8 -> Maybe b -> Maybe b) -> Maybe b -> ByteString -> Maybe b)
-> b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (Word8 -> Maybe b -> Maybe b) -> Maybe b -> ByteString -> Maybe b
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr

anyLazyByteStringSatisfies :: b -> (Word8 -> Maybe b) -> BSL.ByteString -> Maybe b
anyLazyByteStringSatisfies :: forall b. b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
anyLazyByteStringSatisfies = ((Word8 -> Maybe b -> Maybe b) -> Maybe b -> ByteString -> Maybe b)
-> b -> (Word8 -> Maybe b) -> ByteString -> Maybe b
forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (Word8 -> Maybe b -> Maybe b) -> Maybe b -> ByteString -> Maybe b
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BSL.foldr

anySatisfies :: ((a -> Maybe b -> Maybe b) -> Maybe c -> d) -> c -> (a -> Maybe e) -> d
anySatisfies :: forall a b c d e.
((a -> Maybe b -> Maybe b) -> Maybe c -> d)
-> c -> (a -> Maybe e) -> d
anySatisfies (a -> Maybe b -> Maybe b) -> Maybe c -> d
foldFn c
defErr a -> Maybe e
testPred = (a -> Maybe b -> Maybe b) -> Maybe c -> d
foldFn a -> Maybe b -> Maybe b
f (c -> Maybe c
forall a. a -> Maybe a
Just c
defErr)
  where
    f :: a -> Maybe b -> Maybe b
f a
x Maybe b
acc = case a -> Maybe e
testPred a
x of
      Just e
_ -> Maybe b
acc
      Maybe e
Nothing -> Maybe b
forall a. Maybe a
Nothing

-- | Because text used by GHC < 9.4 does not have decodeUtf8Lenient,
-- apparently.
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient :: ByteString -> Text
decodeUtf8Lenient = OnDecodeError -> ByteString -> Text
TEnc.decodeUtf8With OnDecodeError
TEncError.lenientDecode