predicate-typed-0.1.0.0: Predicates, Refinement types and Dsl

Copyright(c) Grant Weyburne 2019
LicenseBSD-3
Maintainergbwey9@gmail.com
Safe HaskellNone
LanguageHaskell2010

Predicate

Description

class P is the main class. Most of this code contains instances of this class that evaluation of expressions at the type level.

Synopsis

Documentation

class P p a where Source #

This is the core class. Each instance of this class can be combined into a dsl using >>

Associated Types

type PP (p :: k) a :: Type Source #

Methods

eval Source #

Arguments

:: MonadEval m 
=> Proxy p 
-> POpts 
-> a 
-> m (TT (PP p a))

returns a tree of results

Instances
GetBool b => P (b :: Bool) a Source #

pulls the type level Bool to the value level

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'True "ignore this"
True
TrueT
>>> pl @'False ()
False
FalseT
Instance details

Defined in Predicate

Associated Types

type PP b a :: Type Source #

Methods

eval :: MonadEval m => Proxy b -> POpts -> a -> m (TT (PP b a)) Source #

GetOrdering cmp => P (cmp :: Ordering) a Source #

extracts the value level representation of the promoted Ordering

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'LT "not used"
Present LT
PresentT LT
>>> pl @'EQ ()
Present EQ
PresentT EQ
Instance details

Defined in Predicate

Associated Types

type PP cmp a :: Type Source #

Methods

eval :: MonadEval m => Proxy cmp -> POpts -> a -> m (TT (PP cmp a)) Source #

KnownNat n => P (n :: Nat) a Source #

extracts the value level representation of the type level Nat

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @123 ()
Present 123
PresentT 123
Instance details

Defined in Predicate

Associated Types

type PP n a :: Type Source #

Methods

eval :: MonadEval m => Proxy n -> POpts -> a -> m (TT (PP n a)) Source #

KnownSymbol s => P (s :: Symbol) a Source #

pulls the type level Symbol to the value level

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @"hello world" ()
Present "hello world"
PresentT "hello world"
Instance details

Defined in Predicate

Associated Types

type PP s a :: Type Source #

Methods

eval :: MonadEval m => Proxy s -> POpts -> a -> m (TT (PP s a)) Source #

P () a Source #

extracts the value level representation of the type level '()

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'() ()
Present ()
PresentT ()
Instance details

Defined in Predicate

Associated Types

type PP () a :: Type Source #

Methods

eval :: MonadEval m => Proxy () -> POpts -> a -> m (TT (PP () a)) Source #

Show a => P () a Source #

const () function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @() "Asf"
Present ()
PresentT ()
Instance details

Defined in Predicate

Associated Types

type PP () a :: Type Source #

Methods

eval :: MonadEval m => Proxy () -> POpts -> a -> m (TT (PP () a)) Source #

(ReverseTupleC tp, Show (ReverseTupleP tp), Show tp) => P ReverseTupleN tp Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReverseTupleN tp :: Type Source #

Methods

eval :: MonadEval m => Proxy ReverseTupleN -> POpts -> tp -> m (TT (PP ReverseTupleN tp)) Source #

P Stdin a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Stdin a :: Type Source #

Methods

eval :: MonadEval m => Proxy Stdin -> POpts -> a -> m (TT (PP Stdin a)) Source #

P TimeZ a Source # 
Instance details

Defined in Predicate

Associated Types

type PP TimeZ a :: Type Source #

Methods

eval :: MonadEval m => Proxy TimeZ -> POpts -> a -> m (TT (PP TimeZ a)) Source #

P TimeU a Source # 
Instance details

Defined in Predicate

Associated Types

type PP TimeU a :: Type Source #

Methods

eval :: MonadEval m => Proxy TimeU -> POpts -> a -> m (TT (PP TimeU a)) Source #

P ReadEnvAll a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReadEnvAll a :: Type Source #

Methods

eval :: MonadEval m => Proxy ReadEnvAll -> POpts -> a -> m (TT (PP ReadEnvAll a)) Source #

a ~ [Int] => P Luhn a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Luhn a :: Type Source #

Methods

eval :: MonadEval m => Proxy Luhn -> POpts -> a -> m (TT (PP Luhn a)) Source #

(Show l, IsList l, Show (Item l)) => P ToListExt l Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToListExt l :: Type Source #

Methods

eval :: MonadEval m => Proxy ToListExt -> POpts -> l -> m (TT (PP ToListExt l)) Source #

(Show (t a), Foldable t, t a ~ as) => P Null as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Null as :: Type Source #

Methods

eval :: MonadEval m => Proxy Null -> POpts -> as -> m (TT (PP Null as)) Source #

(Show as, AsEmpty as) => P IsEmpty as Source # 
Instance details

Defined in Predicate

Associated Types

type PP IsEmpty as :: Type Source #

Methods

eval :: MonadEval m => Proxy IsEmpty -> POpts -> as -> m (TT (PP IsEmpty as)) Source #

(Show (ConsT s), Show s, Snoc s s (ConsT s) (ConsT s)) => P Unsnoc s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unsnoc s :: Type Source #

Methods

eval :: MonadEval m => Proxy Unsnoc -> POpts -> s -> m (TT (PP Unsnoc s)) Source #

(Show (ConsT s), Show s, Cons s s (ConsT s) (ConsT s)) => P Uncons s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Uncons s :: Type Source #

Methods

eval :: MonadEval m => Proxy Uncons -> POpts -> s -> m (TT (PP Uncons s)) Source #

(as ~ t a, Show (t a), Foldable t, a ~ Bool) => P Ors as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ors as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ors -> POpts -> as -> m (TT (PP Ors as)) Source #

(as ~ t a, Show (t a), Foldable t, a ~ Bool) => P Ands as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ands as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ands -> POpts -> as -> m (TT (PP Ands as)) Source #

Show a => P MkJust a Source # 
Instance details

Defined in Predicate

Associated Types

type PP MkJust a :: Type Source #

Methods

eval :: MonadEval m => Proxy MkJust -> POpts -> a -> m (TT (PP MkJust a)) Source #

a ~ Bool => P Not a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Not a :: Type Source #

Methods

eval :: MonadEval m => Proxy Not -> POpts -> a -> m (TT (PP Not a)) Source #

(Show a, Integral a) => P Prime a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Prime a :: Type Source #

Methods

eval :: MonadEval m => Proxy Prime -> POpts -> a -> m (TT (PP Prime a)) Source #

(Show a, Enum a) => P FromEnum a Source # 
Instance details

Defined in Predicate

Associated Types

type PP FromEnum a :: Type Source #

Methods

eval :: MonadEval m => Proxy FromEnum -> POpts -> a -> m (TT (PP FromEnum a)) Source #

(Show a, Enum a) => P Pred a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Pred a :: Type Source #

Methods

eval :: MonadEval m => Proxy Pred -> POpts -> a -> m (TT (PP Pred a)) Source #

(Show a, Enum a) => P Succ a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Succ a :: Type Source #

Methods

eval :: MonadEval m => Proxy Succ -> POpts -> a -> m (TT (PP Succ a)) Source #

(Show t, Reversing t) => P ReverseL t Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReverseL t :: Type Source #

Methods

eval :: MonadEval m => Proxy ReverseL -> POpts -> t -> m (TT (PP ReverseL t)) Source #

(Show a, as ~ [a]) => P Reverse as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Reverse as :: Type Source #

Methods

eval :: MonadEval m => Proxy Reverse -> POpts -> as -> m (TT (PP Reverse as)) Source #

(Show s, Show (Unwrapped s), Wrapped s) => P Unwrap s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unwrap s :: Type Source #

Methods

eval :: MonadEval m => Proxy Unwrap -> POpts -> s -> m (TT (PP Unwrap s)) Source #

(Show a, Num a) => P Signum a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Signum a :: Type Source #

Methods

eval :: MonadEval m => Proxy Signum -> POpts -> a -> m (TT (PP Signum a)) Source #

(Show a, Num a) => P Abs a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Abs a :: Type Source #

Methods

eval :: MonadEval m => Proxy Abs -> POpts -> a -> m (TT (PP Abs a)) Source #

(Show a, Num a) => P Negate a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Negate a :: Type Source #

Methods

eval :: MonadEval m => Proxy Negate -> POpts -> a -> m (TT (PP Negate a)) Source #

Show a => P MkProxy a Source # 
Instance details

Defined in Predicate

Associated Types

type PP MkProxy a :: Type Source #

Methods

eval :: MonadEval m => Proxy MkProxy -> POpts -> a -> m (TT (PP MkProxy a)) Source #

(Typeable a, Show a) => P IdT a Source # 
Instance details

Defined in Predicate

Associated Types

type PP IdT a :: Type Source #

Methods

eval :: MonadEval m => Proxy IdT -> POpts -> a -> m (TT (PP IdT a)) Source #

Show a => P Id a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Id a :: Type Source #

Methods

eval :: MonadEval m => Proxy Id -> POpts -> a -> m (TT (PP Id a)) Source #

P I a Source # 
Instance details

Defined in Predicate

Associated Types

type PP I a :: Type Source #

Methods

eval :: MonadEval m => Proxy I -> POpts -> a -> m (TT (PP I a)) Source #

(Show a, as ~ [a]) => P Len as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Len as :: Type Source #

Methods

eval :: MonadEval m => Proxy Len -> POpts -> as -> m (TT (PP Len as)) Source #

a ~ Day => P UnMkDay a Source # 
Instance details

Defined in Predicate

Associated Types

type PP UnMkDay a :: Type Source #

Methods

eval :: MonadEval m => Proxy UnMkDay -> POpts -> a -> m (TT (PP UnMkDay a)) Source #

Show as => P ShowP as Source # 
Instance details

Defined in Predicate

Associated Types

type PP ShowP as :: Type Source #

Methods

eval :: MonadEval m => Proxy ShowP -> POpts -> as -> m (TT (PP ShowP as)) Source #

(as ~ [a], Show a) => P Ones as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ones as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ones -> POpts -> as -> m (TT (PP Ones as)) Source #

(Show a, IsText a) => P ToUpper a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToUpper a :: Type Source #

Methods

eval :: MonadEval m => Proxy ToUpper -> POpts -> a -> m (TT (PP ToUpper a)) Source #

(Show a, IsText a) => P ToLower a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToLower a :: Type Source #

Methods

eval :: MonadEval m => Proxy ToLower -> POpts -> a -> m (TT (PP ToLower a)) Source #

(Show (t (t a)), Show (t a), Monad t) => P Join (t (t a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Join (t (t a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Join -> POpts -> t (t a) -> m (TT (PP Join (t (t a)))) Source #

(Show (t a), Show (t (t a)), Comonad t) => P Duplicate (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Duplicate (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Duplicate -> POpts -> t a -> m (TT (PP Duplicate (t a))) Source #

(Show (t a), Show a, Comonad t) => P Extract (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Extract (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Extract -> POpts -> t a -> m (TT (PP Extract (t a))) Source #

(Show (f (t a)), Show (t (f a)), Traversable t, Applicative f) => P Sequence (t (f a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Sequence (t (f a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Sequence -> POpts -> t (f a) -> m (TT (PP Sequence (t (f a)))) Source #

(Show (t a), Foldable t, Show a) => P ToList (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToList (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy ToList -> POpts -> t a -> m (TT (PP ToList (t a))) Source #

Show a => P Pairs [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Pairs [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Pairs -> POpts -> [a] -> m (TT (PP Pairs [a])) Source #

(Show a, Show b) => P PartitionThese [These a b] Source # 
Instance details

Defined in Predicate

Associated Types

type PP PartitionThese [These a b] :: Type Source #

Methods

eval :: MonadEval m => Proxy PartitionThese -> POpts -> [These a b] -> m (TT (PP PartitionThese [These a b])) Source #

(Show a, Show b) => P PartitionEithers [Either a b] Source # 
Instance details

Defined in Predicate

Associated Types

type PP PartitionEithers [Either a b] :: Type Source #

Methods

eval :: MonadEval m => Proxy PartitionEithers -> POpts -> [Either a b] -> m (TT (PP PartitionEithers [Either a b])) Source #

(Show a, Monoid a) => P MConcat [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP MConcat [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy MConcat -> POpts -> [a] -> m (TT (PP MConcat [a])) Source #

Functor f => P Fmap_2 (f (x, a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fmap_2 (f (x, a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fmap_2 -> POpts -> f (x, a) -> m (TT (PP Fmap_2 (f (x, a)))) Source #

Functor f => P Fmap_1 (f (a, x)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fmap_1 (f (a, x)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fmap_1 -> POpts -> f (a, x) -> m (TT (PP Fmap_1 (f (a, x)))) Source #

(Ord a, Show a) => P Max [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Max [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Max -> POpts -> [a] -> m (TT (PP Max [a])) Source #

(Ord a, Show a) => P Min [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Min [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Min -> POpts -> [a] -> m (TT (PP Min [a])) Source #

Show a => P Tails [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Tails [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Tails -> POpts -> [a] -> m (TT (PP Tails [a])) Source #

Show a => P Inits [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Inits [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Inits -> POpts -> [a] -> m (TT (PP Inits [a])) Source #

Typeable a => P Unproxy (Proxy a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unproxy (Proxy a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Unproxy -> POpts -> Proxy a -> m (TT (PP Unproxy (Proxy a))) Source #

Monoid a => P MemptyProxy (Proxy a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP MemptyProxy (Proxy a) :: Type Source #

Methods

eval :: MonadEval m => Proxy MemptyProxy -> POpts -> Proxy a -> m (TT (PP MemptyProxy (Proxy a))) Source #

P TheseToMaybe (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP TheseToMaybe (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy TheseToMaybe -> POpts -> These a b -> m (TT (PP TheseToMaybe (These a b))) Source #

P ThatToMaybe (These x a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ThatToMaybe (These x a) :: Type Source #

Methods

eval :: MonadEval m => Proxy ThatToMaybe -> POpts -> These x a -> m (TT (PP ThatToMaybe (These x a))) Source #

P ThisToMaybe (These a x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ThisToMaybe (These a x) :: Type Source #

Methods

eval :: MonadEval m => Proxy ThisToMaybe -> POpts -> These a x -> m (TT (PP ThisToMaybe (These a x))) Source #

P RightToMaybe (Either x a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP RightToMaybe (Either x a) :: Type Source #

Methods

eval :: MonadEval m => Proxy RightToMaybe -> POpts -> Either x a -> m (TT (PP RightToMaybe (Either x a))) Source #

P LeftToMaybe (Either a x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP LeftToMaybe (Either a x) :: Type Source #

Methods

eval :: MonadEval m => Proxy LeftToMaybe -> POpts -> Either a x -> m (TT (PP LeftToMaybe (Either a x))) Source #

(Show (p a b), Swapped p, Show (p b a)) => P Swap (p a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Swap (p a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Swap -> POpts -> p a b -> m (TT (PP Swap (p a b))) Source #

(Show x, Show b) => P Snd (x, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Snd (x, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Snd -> POpts -> (x, b) -> m (TT (PP Snd (x, b))) Source #

(Show x, Show a) => P Fst (a, x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fst (a, x) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fst -> POpts -> (a, x) -> m (TT (PP Fst (a, x))) Source #

(Show x, Show y, Show b) => P Thd3 (x, y, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Thd3 (x, y, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Thd3 -> POpts -> (x, y, b) -> m (TT (PP Thd3 (x, y, b))) Source #

(Show x, Show y, Show b) => P Snd3 (x, b, y) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Snd3 (x, b, y) :: Type Source #

Methods

eval :: MonadEval m => Proxy Snd3 -> POpts -> (x, b, y) -> m (TT (PP Snd3 (x, b, y))) Source #

(Show x, Show y, Show a) => P Fst3 (a, x, y) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fst3 (a, x, y) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fst3 -> POpts -> (a, x, y) -> m (TT (PP Fst3 (a, x, y))) Source #

P ([] :: [k]) a Source #

extracts the value level representation of the type level '[]

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'[] False
Present []
PresentT []
Instance details

Defined in Predicate

Associated Types

type PP [] a :: Type Source #

Methods

eval :: MonadEval m => Proxy [] -> POpts -> a -> m (TT (PP [] a)) Source #

(Show a, 2 <= n, n <= 36, KnownNat n, Integral a) => P (ShowBase n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ShowBase n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ShowBase n) -> POpts -> a -> m (TT (PP (ShowBase n) a)) Source #

(KnownSymbol s, NullT s ~ False) => P (Char1 s :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Char1 s) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Char1 s) -> POpts -> a -> m (TT (PP (Char1 s) a)) Source #

(Show l, IsList l, l ~ l') => P (FromListF l' :: Type) l Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromListF l') l :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromListF l') -> POpts -> l -> m (TT (PP (FromListF l') l)) Source #

Typeable t => P (Hole t :: Type) a Source #

Acts as a proxy in this dsl where you can explicitly set the Type.

It is passed around as an argument to help the type checker when needed. see ReadP, ParseTimeP, ShowP

Instance details

Defined in Predicate

Associated Types

type PP (Hole t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Hole t) -> POpts -> a -> m (TT (PP (Hole t) a)) Source #

(Show (t a), Alternative t) => P (EmptyT t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EmptyT t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (EmptyT t) -> POpts -> a -> m (TT (PP (EmptyT t) a)) Source #

(GetCharSet cs, Show a, IsText a) => P (IsCharSet cs :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsCharSet cs) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsCharSet cs) -> POpts -> a -> m (TT (PP (IsCharSet cs) a)) Source #

P (Nothing :: Maybe a1) (Maybe a2) Source #

expects Nothing otherwise it fails if the value is Nothing then it returns 'Proxy a' as this provides more information than '()'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'Nothing Nothing
Present Proxy
PresentT Proxy
>>> pl @'Nothing (Just True)
Error 'Nothing found Just
FailT "'Nothing found Just"
Instance details

Defined in Predicate

Associated Types

type PP Nothing (Maybe a2) :: Type Source #

Methods

eval :: MonadEval m => Proxy Nothing -> POpts -> Maybe a2 -> m (TT (PP Nothing (Maybe a2))) Source #

(a ~ Item t, Show t, IsList t) => P (FromList t :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromList t) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromList t) -> POpts -> [a] -> m (TT (PP (FromList t) [a])) Source #

(Show (f (t a)), Show (f a), Applicative t, Functor f) => P (Pure2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pure2 t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pure2 t) -> POpts -> f a -> m (TT (PP (Pure2 t) (f a))) Source #

P (Proxy t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Proxy t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Proxy t) -> POpts -> a -> m (TT (PP (Proxy t) a)) Source #

(PP p x ~ String, P p x) => P (ReadEnv p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadEnv p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadEnv p) -> POpts -> x -> m (TT (PP (ReadEnv p) x)) Source #

(PP p x ~ String, P p x) => P (ReadDir p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadDir p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadDir p) -> POpts -> x -> m (TT (PP (ReadDir p) x)) Source #

(PP p x ~ String, P p x) => P (ReadFile p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadFile p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadFile p) -> POpts -> x -> m (TT (PP (ReadFile p) x)) Source #

P p a => P (Hide p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Hide p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Hide p) -> POpts -> a -> m (TT (PP (Hide p) a)) Source #

(Show (PP p a), P p a) => P (Skip p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Skip p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Skip p) -> POpts -> a -> m (TT (PP (Skip p) a)) Source #

P p a => P (W p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (W p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (W p) -> POpts -> a -> m (TT (PP (W p) a)) Source #

Typeable t => P (ProxyT' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ProxyT' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ProxyT' t) -> POpts -> a -> m (TT (PP (ProxyT' t) a)) Source #

(Show a, Show (t [a]), PP p x ~ t [a], P p x, Foldable t) => P (Concat p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Concat p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Concat p) -> POpts -> x -> m (TT (PP (Concat p) x)) Source #

P (MkNothing' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkNothing' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkNothing' t) -> POpts -> a -> m (TT (PP (MkNothing' t) a)) Source #

(Show (PP t a), Monoid (PP t a)) => P (MemptyT' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MemptyT' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MemptyT' t) -> POpts -> a -> m (TT (PP (MemptyT' t) a)) Source #

(Show a, Enum (PP t a), Show (PP t a), Integral a) => P (ToEnum' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToEnum' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToEnum' t) -> POpts -> a -> m (TT (PP (ToEnum' t) a)) Source #

(P def (Proxy a), PP def (Proxy a) ~ a, Show a, Eq a, Bounded a, Enum a) => P (PredB def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (PredB def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (PredB def) -> POpts -> a -> m (TT (PP (PredB def) a)) Source #

(P def (Proxy a), PP def (Proxy a) ~ a, Show a, Eq a, Bounded a, Enum a) => P (SuccB def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SuccB def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (SuccB def) -> POpts -> a -> m (TT (PP (SuccB def) a)) Source #

(Show a, Show t, Coercible t a) => P (Coerce t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Coerce t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Coerce t) -> POpts -> a -> m (TT (PP (Coerce t) a)) Source #

P (TupleI ([] :: [k]) :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleI []) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleI []) -> POpts -> a -> m (TT (PP (TupleI []) a)) Source #

(P p a, P (TupleI ps) a, Show a) => P (TupleI (p ': ps) :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleI (p ': ps)) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleI (p ': ps)) -> POpts -> a -> m (TT (PP (TupleI (p ': ps)) a)) Source #

P (DoExpandT ps) a => P (Do ps :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Do ps) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Do ps) -> POpts -> a -> m (TT (PP (Do ps) a)) Source #

(a ~ PP p x, Show a, Real a, P p x) => P (ToRational p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToRational p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToRational p) -> POpts -> x -> m (TT (PP (ToRational p) x)) Source #

(PP p x ~ t a, P p x, Show (t a), Foldable t) => P (Length p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Length p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Length p) -> POpts -> x -> m (TT (PP (Length p) x)) Source #

(PP p x ~ ([String] -> String), P p x) => P (MakeRR3 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR3 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR3 p) -> POpts -> x -> m (TT (PP (MakeRR3 p) x)) Source #

(PP p x ~ (String -> String), P p x) => P (MakeRR2 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR2 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR2 p) -> POpts -> x -> m (TT (PP (MakeRR2 p) x)) Source #

(PP p x ~ (String -> [String] -> String), P p x) => P (MakeRR1 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR1 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR1 p) -> POpts -> x -> m (TT (PP (MakeRR1 p) x)) Source #

(PP p x ~ String, P p x) => P (MakeRR p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR p) -> POpts -> x -> m (TT (PP (MakeRR p) x)) Source #

(Show (PP p a2), P p a2, Show a2) => P (Just p :: Maybe a1) (Maybe a2) Source #

extracts the 'a' from type level 'Maybe a' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('Just Id) (Just 123)
Present 123
PresentT 123
>>> pl @('Just Not) (Just True)
Present False
PresentT False
>>> pl @('Just Id) Nothing
Error 'Just found Nothing
FailT "'Just found Nothing"
Instance details

Defined in Predicate

Associated Types

type PP (Just p) (Maybe a2) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Just p) -> POpts -> Maybe a2 -> m (TT (PP (Just p) (Maybe a2))) Source #

(Show a, KnownNat n, GetBool strict, TupleListD (ToN n) a, Show (TupleListT (ToN n) a)) => P (TupleListImpl strict n :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleListImpl strict n) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleListImpl strict n) -> POpts -> [a] -> m (TT (PP (TupleListImpl strict n) [a])) Source #

(Show (f a), Show (f (PP t (f a))), Functor f, Monoid (PP t (f a))) => P (MemptyT2' t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MemptyT2' t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (MemptyT2' t) -> POpts -> f a -> m (TT (PP (MemptyT2' t) (f a))) Source #

(Show (f a), Show (f t), Coercible t a, Functor f) => P (Coerce2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Coerce2 t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Coerce2 t) -> POpts -> f a -> m (TT (PP (Coerce2 t) (f a))) Source #

(Show (PP p a2), Show a2, P (p1 ': ps) a2, PP (p1 ': ps) a2 ~ [PP p1 a2], P p a2, PP p a2 ~ PP p1 a2) => P (p ': (p1 ': ps) :: [a1]) a2 Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p ': (p1 ': ps)) a2 :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ': (p1 ': ps)) -> POpts -> a2 -> m (TT (PP (p ': (p1 ': ps)) a2)) Source #

(Show (PP p a), Show a, P p a) => P (p ': ([] :: [k]) :: [k]) a Source #

runs each predicate in turn from the promoted list

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :set -XNoStarIsType
>>> pl @'[1, 2, 3] 999
Present [1,2,3]
PresentT [1,2,3]
>>> pl @'[W 1, W 2, W 3, Id] 999
Present [1,2,3,999]
PresentT [1,2,3,999]
>>> pl @'[W 1, W 2, W 3, Id * 4, Pred] 999
Present [1,2,3,3996,998]
PresentT [1,2,3,3996,998]
>>> :set -XTypeOperators
>>> pl @'[Id * 4, Pred] 999
Present [3996,998]
PresentT [3996,998]
Instance details

Defined in Predicate

Associated Types

type PP (p ': []) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ': []) -> POpts -> a -> m (TT (PP (p ': []) a)) Source #

P (RepeatT n p) x => P (RepeatP n p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (RepeatP n p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (RepeatP n p) -> POpts -> x -> m (TT (PP (RepeatP n p) x)) Source #

(GetFHandle fh, P p a, PP p a ~ String) => P (WritefileImpl fh p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (WritefileImpl fh p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (WritefileImpl fh p) -> POpts -> a -> m (TT (PP (WritefileImpl fh p) a)) Source #

(P p x, Show (PP p x), Show (t (PP p x)), Applicative t) => P (Pure t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pure t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pure t p) -> POpts -> x -> m (TT (PP (Pure t p) x)) Source #

(GetBool pos, KnownNat num, KnownNat den, NotZeroT den) => P (Rat pos num den :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Rat pos num den) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Rat pos num den) -> POpts -> a -> m (TT (PP (Rat pos num den) a)) Source #

(GetBool strict, GetLen ps, P (ParaImpl (LenT ps) strict ps) [a]) => P (ParaImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImplW strict ps) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImplW strict ps) -> POpts -> [a] -> m (TT (PP (ParaImplW strict ps) [a])) Source #

(P def (Proxy a), PP def (Proxy a) ~ a, KnownNat n, Show a) => P (Ix n def :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Ix n def) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (Ix n def) -> POpts -> [a] -> m (TT (PP (Ix n def) [a])) Source #

(Show a, Show b, GetThese th) => P (IsTh th :: Type) (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsTh th) (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsTh th) -> POpts -> These a b -> m (TT (PP (IsTh th) (These a b))) Source #

(FailIfT (NotT (OrT l r)) (Text "Trim': left and right cannot both be False"), GetBool l, GetBool r, IsText (PP p x), P p x) => P (Trim' l r p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Trim' l r p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Trim' l r p) -> POpts -> x -> m (TT (PP (Trim' l r p) x)) Source #

(P p x, P q x, PP p x ~ (a -> b), FnT (PP p x) ~ b, PP q x ~ a, Show a, Show b) => P (p $ q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p $ q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p $ q) -> POpts -> x -> m (TT (PP (p $ q) x)) Source #

(P p a, P q a, Show (t b), Alternative t, t b ~ PP p a, PP q a ~ t b) => P (p <|> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <|> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <|> q) -> POpts -> a -> m (TT (PP (p <|> q) a)) Source #

(Show (t c), P p a, P q a, Show (t b), Applicative t, t b ~ PP p a, PP q a ~ t c) => P (p <* q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <* q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <* q) -> POpts -> a -> m (TT (PP (p <* q) a)) Source #

(P p a, P q a, Show (PP p a), Functor t, PP q a ~ t c, ApplyConstT (PP q a) (PP p a) ~ t (PP p a)) => P (p <$ q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <$ q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <$ q) -> POpts -> a -> m (TT (PP (p <$ q) a)) Source #

(KnownNat (TupleLenT as), PrintC bs, (b, bs) ~ ReverseTupleP (a, as), ReverseTupleC (a, as), Show a, Show as, PrintfArg b, PP s x ~ String, PP p x ~ (a, as), P s x, P p x, CheckT (PP p x) ~ True) => P (Printfn s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Printfn s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Printfn s p) -> POpts -> x -> m (TT (PP (Printfn s p) x)) Source #

(Semigroup (PP p a), PP p a ~ PP q a, P p a, Show (PP q a), P q a) => P (p <> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <> q) -> POpts -> a -> m (TT (PP (p <> q) a)) Source #

(PrintfArg (PP p x), Show (PP p x), PP s x ~ String, P s x, P p x) => P (Printf s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Printf s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Printf s p) -> POpts -> x -> m (TT (PP (Printf s p) x)) Source #

(PP p a ~ [x], PP q a ~ PP p a, P p a, P q a, Show x) => P (Intercalate p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Intercalate p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Intercalate p q) -> POpts -> a -> m (TT (PP (Intercalate p q) a)) Source #

(Show (f y), PP p a ~ f x, PP q a ~ f y, ExtractT (f x) ~ x, ExtractT (f y) ~ y, Show (f x), Align f, Show (f (These x y)), P p a, P q a) => P (ZipTheseF p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ZipTheseF p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ZipTheseF p q) -> POpts -> a -> m (TT (PP (ZipTheseF p q) a)) Source #

(PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (ZipThese p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ZipThese p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ZipThese p q) -> POpts -> a -> m (TT (PP (ZipThese p q) a)) Source #

(Show x, P p x, Typeable (PP t (PP p x)), Show (PP t (PP p x)), FoldableWithIndex (PP t (PP p x)) f, PP p x ~ f a, Show a) => P (IToList' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IToList' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (IToList' t p) -> POpts -> x -> m (TT (PP (IToList' t p) x)) Source #

(PP p a ~ String, PP p a ~ PP q a, P p a, P q a) => P (OrdI p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (OrdI p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (OrdI p q) -> POpts -> a -> m (TT (PP (OrdI p q) a)) Source #

(Ord (PP p a), PP p a ~ PP q a, P p a, Show (PP q a), P q a) => P (OrdP p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (OrdP p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (OrdP p q) -> POpts -> a -> m (TT (PP (OrdP p q) a)) Source #

(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p ~> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p ~> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ~> q) -> POpts -> a -> m (TT (PP (p ~> q) a)) Source #

(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p || q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p || q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p || q) -> POpts -> a -> m (TT (PP (p || q) a)) Source #

(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p && q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p && q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p && q) -> POpts -> a -> m (TT (PP (p && q) a)) Source #

(Show (PP p a), Show (PP q (PP p a)), P p a, P q (PP p a)) => P (p >> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p >> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p >> q) -> POpts -> a -> m (TT (PP (p >> q) a)) Source #

(Show a, P prt a, PP prt a ~ String, P p a, PP p a ~ Bool) => P (Guard prt p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Guard prt p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Guard prt p) -> POpts -> a -> m (TT (PP (Guard prt p) a)) Source #

(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (QuotRem p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (QuotRem p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (QuotRem p q) -> POpts -> a -> m (TT (PP (QuotRem p q) a)) Source #

(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (DivMod p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (DivMod p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (DivMod p q) -> POpts -> a -> m (TT (PP (DivMod p q) a)) Source #

(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (Mod p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Mod p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Mod p q) -> POpts -> a -> m (TT (PP (Mod p q) a)) Source #

(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (Div p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Div p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Div p q) -> POpts -> a -> m (TT (PP (Div p q) a)) Source #

(P p x, P q ((String, x), Proxy (PP p x)), PP p x ~ PP q ((String, x), Proxy (PP p x))) => P (Catch p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Catch p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Catch p q) -> POpts -> x -> m (TT (PP (Catch p q) x)) Source #

(P prt a, PP prt a ~ String) => P (Fail t prt :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Fail t prt) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Fail t prt) -> POpts -> a -> m (TT (PP (Fail t prt) a)) Source #

(P p x, PP q a ~ [x], PP p x ~ Bool, P q a) => P (Break p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Break p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Break p q) -> POpts -> a -> m (TT (PP (Break p q) a)) Source #

(P p x, Show x, PP q a ~ [x], PP p x ~ Bool, P q a) => P (Partition p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Partition p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Partition p q) -> POpts -> a -> m (TT (PP (Partition p q) a)) Source #

(Show (PP p a), P p a, PP q x ~ f a, P q x, Show a, Show (f a), Foldable f) => P (Map p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Map p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Map p q) -> POpts -> x -> m (TT (PP (Map p q) x)) Source #

(PP q a ~ s, PP p s ~ Maybe (b, s), P q a, P p s, Show s, Show b) => P (Unfoldr p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Unfoldr p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Unfoldr p q) -> POpts -> a -> m (TT (PP (Unfoldr p q) a)) Source #

(P p x, P q x, PP p x ~ a, Show a, PP q x ~ a, Enum a) => P (EnumFromTo p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EnumFromTo p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (EnumFromTo p q) -> POpts -> x -> m (TT (PP (EnumFromTo p q) x)) Source #

(P p x, P q x, Show (PP q x), Show (PP p x), Snoc (PP p x) (PP p x) (PP q x) (PP q x)) => P (p +: q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p +: q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p +: q) -> POpts -> x -> m (TT (PP (p +: q) x)) Source #

(P p x, P q x, Show (PP p x), Show (PP q x), Cons (PP q x) (PP q x) (PP p x) (PP p x)) => P (p :+ q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p :+ q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p :+ q) -> POpts -> x -> m (TT (PP (p :+ q) x)) Source #

(P q a, P p a, Show (PP p a), Ixed (PP p a), PP q a ~ Index (PP p a), Show (Index (PP p a)), Show (IxValue (PP p a))) => P (Lookup p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Lookup p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Lookup p q) -> POpts -> a -> m (TT (PP (Lookup p q) a)) Source #

(P p a, P q a, Show (PP p a), Show (PP q a)) => P (MkThese p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThese p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThese p q) -> POpts -> a -> m (TT (PP (MkThese p q) a)) Source #

(Show (PP p x), P p x) => P (MkThat' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThat' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThat' t p) -> POpts -> x -> m (TT (PP (MkThat' t p) x)) Source #

(Show (PP p x), P p x) => P (MkThis' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThis' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThis' t p) -> POpts -> x -> m (TT (PP (MkThis' t p) x)) Source #

(Show (PP p x), P p x) => P (MkRight' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkRight' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkRight' t p) -> POpts -> x -> m (TT (PP (MkRight' t p) x)) Source #

(Show (PP p x), P p x) => P (MkLeft' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkLeft' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkLeft' t p) -> POpts -> x -> m (TT (PP (MkLeft' t p) x)) Source #

(P n a, Integral (PP n a), Semigroup (PP p a), P p a, Show (PP p a)) => P (STimes n p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (STimes n p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (STimes n p) -> POpts -> a -> m (TT (PP (STimes n p) a)) Source #

([PP p a] ~ PP q a, P p a, P q a, Show (PP p a), Eq (PP p a)) => P (Elem p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Elem p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Elem p q) -> POpts -> a -> m (TT (PP (Elem p q) a)) Source #

(P def (Proxy (PP t a)), PP def (Proxy (PP t a)) ~ PP t a, Show a, Show (PP t a), Bounded (PP t a), Enum (PP t a), Integral a) => P (ToEnumB' t def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToEnumB' t def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToEnumB' t def) -> POpts -> a -> m (TT (PP (ToEnumB' t def) a)) Source #

(Show (PP p x), P p x, Unwrapped (PP s x) ~ PP p x, Wrapped (PP s x), Show (PP s x)) => P (Wrap' s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Wrap' s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Wrap' s p) -> POpts -> x -> m (TT (PP (Wrap' s p) x)) Source #

(PP p a ~ PP q a, Eq (PP q a), P p a, P q a, Show (PP p a), Fractional (PP p a)) => P (DivF p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (DivF p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (DivF p q) -> POpts -> a -> m (TT (PP (DivF p q) a)) Source #

(PP p a ~ [b], P n a, P p a, Show b, Integral (PP n a)) => P (SplitAt n p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SplitAt n p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (SplitAt n p) -> POpts -> a -> m (TT (PP (SplitAt n p) a)) Source #

(P ns x, P p x, PP p x ~ [a], Show n, Show a, PP ns x ~ [n], Integral n) => P (SplitAts ns p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SplitAts ns p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SplitAts ns p) -> POpts -> x -> m (TT (PP (SplitAts ns p) x)) Source #

(P prt a, PP prt a ~ String, P p a) => P (Msg prt p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Msg prt p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Msg prt p) -> POpts -> a -> m (TT (PP (Msg prt p) a)) Source #

(Show (PP p a), P b a, P p a, PP b a ~ Bool) => P (MaybeB b p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeB b p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeB b p) -> POpts -> a -> m (TT (PP (MaybeB b p) a)) Source #

(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Floor' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Floor' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Floor' t p) -> POpts -> x -> m (TT (PP (Floor' t p) x)) Source #

(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Ceiling' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Ceiling' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Ceiling' t p) -> POpts -> x -> m (TT (PP (Ceiling' t p) x)) Source #

(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Truncate' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Truncate' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Truncate' t p) -> POpts -> x -> m (TT (PP (Truncate' t p) x)) Source #

(P r a, PP r a ~ Rational, Show (PP t a), Fractional (PP t a)) => P (FromRational' t r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromRational' t r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromRational' t r) -> POpts -> a -> m (TT (PP (FromRational' t r) a)) Source #

(Num (PP t a), Integral (PP n a), P n a, Show (PP t a), Show (PP n a)) => P (FromIntegral' t n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromIntegral' t n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromIntegral' t n) -> POpts -> a -> m (TT (PP (FromIntegral' t n) a)) Source #

(Num (PP t a), Integral (PP n a), P n a, Show (PP t a)) => P (FromInteger' t n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromInteger' t n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromInteger' t n) -> POpts -> a -> m (TT (PP (FromInteger' t n) a)) Source #

(P s a, PP s a ~ String, Show (PP t a), IsString (PP t a)) => P (FromStringP' t s :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromStringP' t s) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromStringP' t s) -> POpts -> a -> m (TT (PP (FromStringP' t s) a)) Source #

(PP p x ~ s, P p x, Show s, Field4 s s (PP t x) (PP t x), Show (PP t x)) => P (FthL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FthL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FthL' t p) -> POpts -> x -> m (TT (PP (FthL' t p) x)) Source #

(PP p x ~ s, P p x, Show s, Field3 s s (PP t x) (PP t x), Show (PP t x)) => P (ThdL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ThdL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ThdL' t p) -> POpts -> x -> m (TT (PP (ThdL' t p) x)) Source #

(PP p x ~ s, P p x, Show s, Field2 s s (PP t x) (PP t x), Show (PP t x)) => P (SndL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SndL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SndL' t p) -> POpts -> x -> m (TT (PP (SndL' t p) x)) Source #

(PP p x ~ s, P p x, Show s, Field1 s s (PP t x) (PP t x), Show (PP t x)) => P (FstL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FstL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FstL' t p) -> POpts -> x -> m (TT (PP (FstL' t p) x)) Source #

(P p (a, a), P q x, Show a, PP q x ~ [a], PP p (a, a) ~ Ordering) => P (SortBy p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SortBy p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SortBy p q) -> POpts -> x -> m (TT (PP (SortBy p q) x)) Source #

(P p x, PP p x ~ String, Typeable (PP t x), Show (PP t x), Read (PP t x)) => P (ReadP'' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadP'' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadP'' t p) -> POpts -> x -> m (TT (PP (ReadP'' t p) x)) Source #

(PP p x ~ String, FormatTime (PP q x), P p x, Show (PP q x), P q x) => P (FormatTimeP p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FormatTimeP p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FormatTimeP p q) -> POpts -> x -> m (TT (PP (FormatTimeP p q) x)) Source #

(TypeError (Text "ParaImpl '[] invalid: requires at least one value in the list") :: Constraint) => P (ParaImpl n strict ([] :: [k]) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict []) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict []) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict []) [a])) Source #

(KnownNat n, GetBool strict, GetLen ps, P p a, P (ParaImpl n strict (p1 ': ps)) [a], PP (ParaImpl n strict (p1 ': ps)) [a] ~ [PP p a], Show a, Show (PP p a)) => P (ParaImpl n strict (p ': (p1 ': ps)) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict (p ': (p1 ': ps))) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict (p ': (p1 ': ps))) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict (p ': (p1 ': ps))) [a])) Source #

(Show (PP p a), KnownNat n, GetBool strict, Show a, P p a) => P (ParaImpl n strict (p ': ([] :: [k])) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict (p ': [])) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict (p ': [])) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict (p ': [])) [a])) Source #

(GetBool strict, GetLen ps, P (GuardsImpl (LenT ps) strict ps) [a]) => P (GuardsImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImplW strict ps) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImplW strict ps) -> POpts -> [a] -> m (TT (PP (GuardsImplW strict ps) [a])) Source #

(P q a, Show a, Show (PP q a), PP p (Proxy (PP q a)) ~ PP q a, P p (Proxy (PP q a))) => P (MaybeIn p q :: Type) (Maybe a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeIn p q) (Maybe a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeIn p q) -> POpts -> Maybe a -> m (TT (PP (MaybeIn p q) (Maybe a))) Source #

(Show (PP p a), Show (PP q b), P p a, P q b, Show a, Show b) => P (p +++ q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p +++ q) (Either a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p +++ q) -> POpts -> Either a b -> m (TT (PP (p +++ q) (Either a b))) Source #

(Show (PP p a), P p a, P q b, PP p a ~ PP q b, Show a, Show b) => P (p ||| q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p ||| q) (Either a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ||| q) -> POpts -> Either a b -> m (TT (PP (p ||| q) (Either a b))) Source #

(Show (PP p a), Show (PP q b), P p a, P q b, Show a, Show b) => P (p *** q :: Type) (a, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p *** q) (a, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p *** q) -> POpts -> (a, b) -> m (TT (PP (p *** q) (a, b))) Source #

(GetBool r, PP p x ~ String, P p x, IsText (PP q x), P q x) => P (StripLR r p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (StripLR r p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (StripLR r p q) -> POpts -> x -> m (TT (PP (StripLR r p q) x)) Source #

(Typeable (PP t x), BetweenT 2 36 n, Show (PP t x), Num (PP t x), KnownNat n, PP p x ~ String, P p x) => P (ReadBase' t n p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadBase' t n p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadBase' t n p) -> POpts -> x -> m (TT (PP (ReadBase' t n p) x)) Source #

(PP p a ~ String, GetOrd o, PP p a ~ PP q a, P p a, P q a) => P (CmpI o p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CmpI o p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (CmpI o p q) -> POpts -> a -> m (TT (PP (CmpI o p q) a)) Source #

(GetOrd o, Ord (PP p a), Show (PP p a), PP p a ~ PP q a, P p a, P q a) => P (Cmp o p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Cmp o p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Cmp o p q) -> POpts -> a -> m (TT (PP (Cmp o p q) a)) Source #

(GetBool keep, Eq a, Show a, P p x, P q x, PP p x ~ PP q x, PP q x ~ [a]) => P (KeepImpl keep p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (KeepImpl keep p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (KeepImpl keep p q) -> POpts -> x -> m (TT (PP (KeepImpl keep p q) x)) Source #

(GetBinOp op, PP p a ~ PP q a, P p a, P q a, Show (PP p a), Num (PP p a)) => P (Bin op p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Bin op p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Bin op p q) -> POpts -> a -> m (TT (PP (Bin op p q) a)) Source #

(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Resplit' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Resplit' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Resplit' rs p q) -> POpts -> x -> m (TT (PP (Resplit' rs p q) x)) Source #

(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (RescanRanges' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (RescanRanges' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (RescanRanges' rs p q) -> POpts -> x -> m (TT (PP (RescanRanges' rs p q) x)) Source #

(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Rescan' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Rescan' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Rescan' rs p q) -> POpts -> x -> m (TT (PP (Rescan' rs p q) x)) Source #

(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Re' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Re' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Re' rs p q) -> POpts -> x -> m (TT (PP (Re' rs p q) x)) Source #

(KnownNat n, GetBool strict, Show a) => P (GuardsImpl n strict ([] :: [(k, k1)]) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImpl n strict []) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImpl n strict []) -> POpts -> [a] -> m (TT (PP (GuardsImpl n strict []) [a])) Source #

(PP prt (Int, a) ~ String, P prt (Int, a), KnownNat n, GetBool strict, GetLen ps, P p a, PP p a ~ Bool, P (GuardsImpl n strict ps) [a], PP (GuardsImpl n strict ps) [a] ~ [a], Show a) => P (GuardsImpl n strict ((,) prt p ': ps) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImpl n strict ((prt, p) ': ps)) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImpl n strict ((prt, p) ': ps)) -> POpts -> [a] -> m (TT (PP (GuardsImpl n strict ((prt, p) ': ps)) [a])) Source #

(GetBool ignore, P p a, P q a, PP p a ~ String, PP q a ~ String, GetOrdering cmp) => P (IsFixImpl cmp ignore p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsFixImpl cmp ignore p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsFixImpl cmp ignore p q) -> POpts -> a -> m (TT (PP (IsFixImpl cmp ignore p q) a)) Source #

(GetBool lc, GetBool rc, PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (Zip lc rc p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Zip lc rc p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Zip lc rc p q) -> POpts -> a -> m (TT (PP (Zip lc rc p q) a)) Source #

(Show (PP r a), P p a, PP p a ~ Bool, P q a, P r a, PP q a ~ PP r a) => P (If p q r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (If p q r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (If p q r) -> POpts -> a -> m (TT (PP (If p q r) a)) Source #

(PP p (b, a) ~ b, PP q x ~ b, PP r x ~ [a], P p (b, a), P q x, P r x, Show b, Show a) => P (Scanl p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Scanl p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Scanl p q r) -> POpts -> x -> m (TT (PP (Scanl p q r) x)) Source #

(P q a, P p a, Show (PP p a), Ixed (PP p a), PP q a ~ Index (PP p a), Show (Index (PP p a)), Show (IxValue (PP p a)), P r (Proxy (IxValue (PP p a))), PP r (Proxy (IxValue (PP p a))) ~ IxValue (PP p a)) => P (IxL p q r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IxL p q r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IxL p q r) -> POpts -> a -> m (TT (PP (IxL p q r) a)) Source #

(P r x, P p (x, a), P q (x, b), PP r x ~ Either a b, PP p (x, a) ~ c, PP q (x, b) ~ c) => P (EitherX p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EitherX p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (EitherX p q r) -> POpts -> x -> m (TT (PP (EitherX p q r) x)) Source #

(P r x, P p (x, Proxy a), P q (x, a), PP r x ~ Maybe a, PP p (x, Proxy a) ~ b, PP q (x, a) ~ b) => P (MaybeXP p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeXP p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeXP p q r) -> POpts -> x -> m (TT (PP (MaybeXP p q r) x)) Source #

(Show (PP p a), P p a, Show (PP q a), P q a, P b a, PP b a ~ Bool) => P (EitherB b p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EitherB b p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (EitherB b p q) -> POpts -> a -> m (TT (PP (EitherB b p q) a)) Source #

(P p x, P q x, P r x, PP p x ~ Int, PP q x ~ Int, PP r x ~ Int) => P (MkDay p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkDay p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkDay p q r) -> POpts -> x -> m (TT (PP (MkDay p q r) x)) Source #

(ParseTime (PP t a), Typeable (PP t a), Show (PP t a), P p a, P q a, PP p a ~ [String], PP q a ~ String) => P (ParseTimes' t p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParseTimes' t p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParseTimes' t p q) -> POpts -> a -> m (TT (PP (ParseTimes' t p q) a)) Source #

(ParseTime (PP t a), Typeable (PP t a), Show (PP t a), P p a, P q a, PP p a ~ String, PP q a ~ String) => P (ParseTimeP' t p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParseTimeP' t p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParseTimeP' t p q) -> POpts -> a -> m (TT (PP (ParseTimeP' t p q) a)) Source #

(Show a, Show b, Show (PP p a), P p a, P q b, P r (a, b), PP p a ~ PP q b, PP p a ~ PP r (a, b), PP q b ~ PP r (a, b)) => P (TheseIn p q r :: Type) (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TheseIn p q r) (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (TheseIn p q r) -> POpts -> These a b -> m (TT (PP (TheseIn p q r) (These a b))) Source #

(P n a, GetBool left, Integral (PP n a), [PP p a] ~ PP q a, P p a, P q a, Show (PP p a)) => P (Pad left n p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pad left n p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pad left n p q) -> POpts -> a -> m (TT (PP (Pad left n p q) a)) Source #

(FailIfT (NotT (LenT ps == LenT qs)) (((Text "lengths are not the same " :<>: ShowType (LenT ps)) :<>: Text " vs ") :<>: ShowType (LenT qs)), P (CaseImpl (LenT ps) e ps qs r) x) => P (Case e ps qs r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Case e ps qs r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Case e ps qs r) -> POpts -> x -> m (TT (PP (Case e ps qs r) x)) Source #

(P s x, P p (x, a), P q (x, b), P r (x, (a, b)), PP s x ~ These a b, PP p (x, a) ~ c, PP q (x, b) ~ c, PP r (x, (a, b)) ~ c) => P (TheseX p q r s :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TheseX p q r s) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (TheseX p q r s) -> POpts -> x -> m (TT (PP (TheseX p q r s) x)) Source #

(GetBool b, GetROpts rs, PP p x ~ String, PP q x ~ RR, PP r x ~ String, P p x, P q x, P r x) => P (ReplaceImpl b rs p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReplaceImpl b rs p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReplaceImpl b rs p q r) -> POpts -> x -> m (TT (PP (ReplaceImpl b rs p q r) x)) Source #

(KnownNat n, GetLen ps, P r x, P p (PP r x), P q (PP r x), PP p (PP r x) ~ Bool, Show (PP q (PP r x)), Show (PP r x), P (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x, PP (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x ~ PP q (PP r x)) => P (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) x)) Source #

(P r x, P q (PP r x), Show (PP q (PP r x)), P p (PP r x), PP p (PP r x) ~ Bool, KnownNat n, Show (PP r x), P e (PP r x, Proxy (PP q (PP r x))), PP e (PP r x, Proxy (PP q (PP r x))) ~ PP q (PP r x)) => P (CaseImpl n e (p ': ([] :: [k])) (q ': ([] :: [k1])) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': []) (q ': []) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': []) (q ': []) r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': []) (q ': []) r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: lists are both empty") :: Constraint) => P (CaseImpl n e ([] :: [k]) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e [] [] r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e [] [] r) -> POpts -> x -> m (TT (PP (CaseImpl n e [] [] r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: rhs requires at least one value in the list") :: Constraint) => P (CaseImpl n e (p ': ps) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': ps) [] r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': ps) [] r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': ps) [] r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: lhs requires at least one value in the list") :: Constraint) => P (CaseImpl n e ([] :: [k]) (q ': qs) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e [] (q ': qs) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e [] (q ': qs) r) -> POpts -> x -> m (TT (PP (CaseImpl n e [] (q ': qs) r) x)) Source #

Show a => P (Proxy :: Proxy t) a Source #

converts the value to the corresponding Proxy

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'Proxy 'x'
Present Proxy
PresentT Proxy
Instance details

Defined in Predicate

Associated Types

type PP Proxy a :: Type Source #

Methods

eval :: MonadEval m => Proxy Proxy0 -> POpts -> a -> m (TT (PP Proxy0 a)) Source #

(Show a2, Show (PP p a2), P p a2) => P (Right p :: Either a1 b) (Either x a2) Source #

extracts the 'b' from type level 'Either a b' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('Right Id) (Right 123)
Present 123
PresentT 123
>>> pl @('Right Id) (Left "aaa")
Error 'Right found Left
FailT "'Right found Left"
Instance details

Defined in Predicate

Associated Types

type PP (Right p) (Either x a2) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Right p) -> POpts -> Either x a2 -> m (TT (PP (Right p) (Either x a2))) Source #

(Show a2, Show (PP p a2), P p a2) => P (Left p :: Either a1 b) (Either a2 x) Source #

extracts the 'a' from type level 'Either a b' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('Left Id) (Left 123)
Present 123
PresentT 123
>>> pl @('Left Id) (Right "aaa")
Error 'Left found Right
FailT "'Left found Right"
Instance details

Defined in Predicate

Associated Types

type PP (Left p) (Either a2 x) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Left p) -> POpts -> Either a2 x -> m (TT (PP (Left p) (Either a2 x))) Source #

(Show a2, Show (PP p a2), P p a2) => P (That p :: These a1 b) (These x a2) Source #

extracts the 'b' from type level 'These a b' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('That Id) (That 123)
Present 123
PresentT 123
>>> pl @('That Id) (This "aaa")
Error 'That found This
FailT "'That found This"
>>> pl @('That Id) (These 44 "aaa")
Error 'That found These
FailT "'That found These"
Instance details

Defined in Predicate

Associated Types

type PP (That p) (These x a2) :: Type Source #

Methods

eval :: MonadEval m => Proxy (That p) -> POpts -> These x a2 -> m (TT (PP (That p) (These x a2))) Source #

(Show a2, Show (PP p a2), P p a2) => P (This p :: These a1 b) (These a2 x) Source #

extracts the 'a' from type level 'These a b' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('This Id) (This 123)
Present 123
PresentT 123
>>> pl @('This Id) (That "aaa")
Error 'This found That
FailT "'This found That"
>>> pl @('This Id) (These 999 "aaa")
Error 'This found These
FailT "'This found These"
Instance details

Defined in Predicate

Associated Types

type PP (This p) (These a2 x) :: Type Source #

Methods

eval :: MonadEval m => Proxy (This p) -> POpts -> These a2 x -> m (TT (PP (This p) (These a2 x))) Source #

(P p a, P q a) => P ((,) p q :: (k2, k1)) a Source #

run the predicates in a promoted 2-tuple; similar to &&&

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'(Snd, Fst) ("helo",123)
Present (123,"helo")
PresentT (123,"helo")
>>> :set -XTypeOperators
>>> pl @'(Len, Id <> "|" <> Reverse) "helo"
Present (4,"helo|oleh")
PresentT (4,"helo|oleh")
Instance details

Defined in Predicate

Associated Types

type PP (p, q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p, q) -> POpts -> a -> m (TT (PP (p, q) a)) Source #

(Show a2, Show b2, P p a2, P q b2, Show (PP p a2), Show (PP q b2)) => P (These p q :: These a1 b1) (These a2 b2) Source #

extracts the (a,b) from type level 'These a b' if the value exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @('These Id Id) (These 123 "abc")
Present (123,"abc")
PresentT (123,"abc")
>>> pl @('These Pred Len) (These 123 "abcde")
Present (122,5)
PresentT (122,5)
>>> pl @('These Id Id) (This "aaa")
Error 'These found This
FailT "'These found This"
>>> pl @('These Id Id) (That "aaa")
Error 'These found That
FailT "'These found That"
Instance details

Defined in Predicate

Associated Types

type PP (These p q) (These a2 b2) :: Type Source #

Methods

eval :: MonadEval m => Proxy (These p q) -> POpts -> These0 a2 b2 -> m (TT (PP (These p q) (These0 a2 b2))) Source #

(P p a, P q a, P r a) => P ((,,) p q r :: (k3, k2, k1)) a Source #

run the predicates in a promoted 3-tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'(Len, Id, Reverse) "helo"
Present (4,"helo","oleh")
PresentT (4,"helo","oleh")
Instance details

Defined in Predicate

Associated Types

type PP (p, q, r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p, q, r) -> POpts -> a -> m (TT (PP (p, q, r) a)) Source #

(P p a, P q a, P r a, P s a) => P ((,,,) p q r s :: (k4, k3, k2, k1)) a Source #

run the predicates in a promoted 4-tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @'(Len, Id, "inj", 999) "helo"
Present (4,"helo","inj",999)
PresentT (4,"helo","inj",999)
Instance details

Defined in Predicate

Associated Types

type PP (p, q, r, s) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p, q, r, s) -> POpts -> a -> m (TT (PP (p, q, r, s) a)) Source #

evalBool :: (MonadEval m, P p a, PP p a ~ Bool) => Proxy p -> POpts -> a -> m (TT (PP p a)) Source #

A specialised form of eval that works only on predicates

type Asc = Map (Fst <= Snd) Pairs >> Ands Source #

a type level predicate for a monotonic increasing list

type Asc' = Map (Fst < Snd) Pairs >> Ands Source #

a type level predicate for a strictly increasing list

type Desc = Map (Fst >= Snd) Pairs >> Ands Source #

a type level predicate for a monotonic decreasing list

type Desc' = Map (Fst > Snd) Pairs >> Ands Source #

a type level predicate for a strictly decreasing list

type Between p q = Ge p && Le q Source #

A predicate that determines if the value is between 'p' and 'q' The values can be rational numbers using Rat or plain Natural numbers

type Between' p q r = (r >= p) && (r <= q) Source #

This is the same as Between but where 'r' is Id

type AllPositive = Map Positive >> Ands Source #

a type level predicate for all positive elements in a list

type AllNegative = Map Negative >> Ands Source #

a type level predicate for all negative elements in a list

type Positive = Ge 0 Source #

type Negative = Le 0 Source #

type All x = Map x Id >> Ands Source #

type Any x = Map x Id >> Ors Source #

type Unzip = (Map Fst Id, Map Snd Id) Source #

unzip equivalent

data Re' (rs :: [ROpt]) p q Source #

represents a predicate using a Symbol as a regular expression evaluates Re and returns True if there is a match

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Re "^\\d{2}:\\d{2}:\\d{2}$" Id) "13:05:25"
True
TrueT
Instances
(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Re' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Re' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Re' rs p q) -> POpts -> x -> m (TT (PP (Re' rs p q) x)) Source #

type PP (Re' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Re' rs p q :: Type) x = Bool

type Re p q = Re' '[] p q Source #

data Rescan' (rs :: [ROpt]) p q Source #

runs a regex matcher returning the original values and optionally any groups

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Rescan "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
Present [("13:05:25",["13","05","25"])]
PresentT [("13:05:25",["13","05","25"])]
Instances
(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Rescan' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Rescan' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Rescan' rs p q) -> POpts -> x -> m (TT (PP (Rescan' rs p q) x)) Source #

type PP (Rescan' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Rescan' rs p q :: Type) x = [(String, [String])]

type Rescan p q = Rescan' '[] p q Source #

data RescanRanges' (rs :: [ROpt]) p q Source #

similar to Rescan but gives the column start and ending positions instead of values

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(RescanRanges "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
Present [((0,8),[(0,2),(3,5),(6,8)])]
PresentT [((0,8),[(0,2),(3,5),(6,8)])]
Instances
(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (RescanRanges' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (RescanRanges' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (RescanRanges' rs p q) -> POpts -> x -> m (TT (PP (RescanRanges' rs p q) x)) Source #

type PP (RescanRanges' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (RescanRanges' rs p q :: Type) x = [((Int, Int), [(Int, Int)])]

type RescanRanges p q = RescanRanges' '[] p q Source #

data Resplit' (rs :: [ROpt]) p q Source #

splits a string on a regex delimiter

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Resplit "\\." Id) "141.201.1.22"
Present ["141","201","1","22"]
PresentT ["141","201","1","22"]
Instances
(GetROpts rs, PP p x ~ String, PP q x ~ String, P p x, P q x) => P (Resplit' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Resplit' rs p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Resplit' rs p q) -> POpts -> x -> m (TT (PP (Resplit' rs p q) x)) Source #

type PP (Resplit' rs p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Resplit' rs p q :: Type) x = [String]

type Resplit p q = Resplit' '[] p q Source #

data ReplaceImpl (alle :: Bool) (rs :: [ROpt]) p q r Source #

replaces regex 's' with a string 's1' inside the value

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ReplaceAllString "\\." ":" Id) "141.201.1.22"
Present "141:201:1:22"
PresentT "141:201:1:22"
Instances
(GetBool b, GetROpts rs, PP p x ~ String, PP q x ~ RR, PP r x ~ String, P p x, P q x, P r x) => P (ReplaceImpl b rs p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReplaceImpl b rs p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReplaceImpl b rs p q r) -> POpts -> x -> m (TT (PP (ReplaceImpl b rs p q r) x)) Source #

type PP (ReplaceImpl b rs p q r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReplaceImpl b rs p q r :: Type) x = String

type ReplaceAll' (rs :: [ROpt]) p q r = ReplaceImpl True rs p q r Source #

type ReplaceAll p q r = ReplaceAll' '[] p q r Source #

type ReplaceOne' (rs :: [ROpt]) p q r = ReplaceImpl False rs p q r Source #

type ReplaceOne p q r = ReplaceOne' '[] p q r Source #

type ReplaceAllString' (rs :: [ROpt]) p q r = ReplaceAll' rs p (MakeRR q) r Source #

type ReplaceOneString' (rs :: [ROpt]) p q r = ReplaceOne' rs p (MakeRR q) r Source #

data MakeRR p Source #

Simple replacement string: see ReplaceAllString and ReplaceOneString

Instances
(PP p x ~ String, P p x) => P (MakeRR p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR p) -> POpts -> x -> m (TT (PP (MakeRR p) x)) Source #

type PP (MakeRR p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MakeRR p :: Type) x = RR

data MakeRR1 p Source #

A replacement function (String -> [String] -> String) which returns the whole match and the groups Used by sub and sub Requires Text.Show.Functions

Instances
(PP p x ~ (String -> [String] -> String), P p x) => P (MakeRR1 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR1 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR1 p) -> POpts -> x -> m (TT (PP (MakeRR1 p) x)) Source #

type PP (MakeRR1 p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MakeRR1 p :: Type) x = RR

data MakeRR2 p Source #

A replacement function (String -> String) that yields the whole match Used by sub and sub Requires Text.Show.Functions

>>> :m + Text.Show.Functions
>>> pl @(ReplaceAll "\\." (MakeRR2 Fst) Snd) (\x -> x <> ":" <> x, "141.201.1.22")
Present "141.:.201.:.1.:.22"
PresentT "141.:.201.:.1.:.22"
Instances
(PP p x ~ (String -> String), P p x) => P (MakeRR2 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR2 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR2 p) -> POpts -> x -> m (TT (PP (MakeRR2 p) x)) Source #

type PP (MakeRR2 p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MakeRR2 p :: Type) x = RR

data MakeRR3 p Source #

A replacement function ([String] -> String) which yields the groups Used by sub and sub Requires Text.Show.Functions

>>> :m + Text.Show.Functions
>>> pl @(ReplaceAll "^(\\d+)\\.(\\d+)\\.(\\d+)\\.(\\d+)$" (MakeRR3 Fst) Snd) (\ys -> intercalate  " | " $ map (show . succ . read @Int) ys, "141.201.1.22")
Present "142 | 202 | 2 | 23"
PresentT "142 | 202 | 2 | 23"
Instances
(PP p x ~ ([String] -> String), P p x) => P (MakeRR3 p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MakeRR3 p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MakeRR3 p) -> POpts -> x -> m (TT (PP (MakeRR3 p) x)) Source #

type PP (MakeRR3 p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MakeRR3 p :: Type) x = RR

data IsCharSet (cs :: CharSet) Source #

a predicate for determining if a string IsText belongs to the given character set

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> import qualified Data.Text as T
>>> pl @IsLower "abc"
True
TrueT
>>> pl @IsLower "abcX"
False
FalseT
>>> pl @IsLower (T.pack "abcX")
False
FalseT
>>> pl @IsHexDigit "01efA"
True
TrueT
>>> pl @IsHexDigit "01egfA"
False
FalseT
Instances
(GetCharSet cs, Show a, IsText a) => P (IsCharSet cs :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsCharSet cs) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsCharSet cs) -> POpts -> a -> m (TT (PP (IsCharSet cs) a)) Source #

type PP (IsCharSet cs :: Type) a Source # 
Instance details

Defined in Predicate

type PP (IsCharSet cs :: Type) a = Bool

class GetCharSet (cs :: CharSet) where Source #

Instances
GetCharSet CLower Source # 
Instance details

Defined in Predicate

GetCharSet CUpper Source # 
Instance details

Defined in Predicate

GetCharSet CNumber Source # 
Instance details

Defined in Predicate

GetCharSet CPunctuation Source # 
Instance details

Defined in Predicate

GetCharSet CControl Source # 
Instance details

Defined in Predicate

GetCharSet CHexDigit Source # 
Instance details

Defined in Predicate

GetCharSet COctDigit Source # 
Instance details

Defined in Predicate

GetCharSet CSeparator Source # 
Instance details

Defined in Predicate

GetCharSet CLatin1 Source # 
Instance details

Defined in Predicate

data ToLower Source #

converts a string IsText value to lower case

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @ToLower "HeLlO wOrld!"
Present "hello world!"
PresentT "hello world!"
Instances
(Show a, IsText a) => P ToLower a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToLower a :: Type Source #

Methods

eval :: MonadEval m => Proxy ToLower -> POpts -> a -> m (TT (PP ToLower a)) Source #

type PP ToLower a Source # 
Instance details

Defined in Predicate

type PP ToLower a = a

data ToUpper Source #

converts a string IsText value to upper case

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @ToUpper "HeLlO wOrld!"
Present "HELLO WORLD!"
PresentT "HELLO WORLD!"
Instances
(Show a, IsText a) => P ToUpper a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToUpper a :: Type Source #

Methods

eval :: MonadEval m => Proxy ToUpper -> POpts -> a -> m (TT (PP ToUpper a)) Source #

type PP ToUpper a Source # 
Instance details

Defined in Predicate

type PP ToUpper a = a

data Inits Source #

similar to inits

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Inits [4,8,3,9]
Present [[],[4],[4,8],[4,8,3],[4,8,3,9]]
PresentT [[],[4],[4,8],[4,8,3],[4,8,3,9]]
>>> pl @Inits []
Present [[]]
PresentT [[]]
Instances
Show a => P Inits [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Inits [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Inits -> POpts -> [a] -> m (TT (PP Inits [a])) Source #

type PP Inits [a] Source # 
Instance details

Defined in Predicate

type PP Inits [a] = [[a]]

data Tails Source #

similar to tails

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Tails [4,8,3,9]
Present [[4,8,3,9],[8,3,9],[3,9],[9],[]]
PresentT [[4,8,3,9],[8,3,9],[3,9],[9],[]]
>>> pl @Tails []
Present [[]]
PresentT [[]]
Instances
Show a => P Tails [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Tails [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Tails -> POpts -> [a] -> m (TT (PP Tails [a])) Source #

type PP Tails [a] Source # 
Instance details

Defined in Predicate

type PP Tails [a] = [[a]]

data Ones Source #

split a list into single values

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Ones [4,8,3,9]
Present [[4],[8],[3],[9]]
PresentT [[4],[8],[3],[9]]
>>> pl @Ones []
Present []
PresentT []
Instances
(as ~ [a], Show a) => P Ones as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ones as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ones -> POpts -> as -> m (TT (PP Ones as)) Source #

type PP Ones as Source # 
Instance details

Defined in Predicate

type PP Ones as = [as]

data ShowP Source #

similar to show

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @ShowP [4,8,3,9]
Present "[4,8,3,9]"
PresentT "[4,8,3,9]"
>>> pl @ShowP 'x'
Present "'x'"
PresentT "'x'"
Instances
Show as => P ShowP as Source # 
Instance details

Defined in Predicate

Associated Types

type PP ShowP as :: Type Source #

Methods

eval :: MonadEval m => Proxy ShowP -> POpts -> as -> m (TT (PP ShowP as)) Source #

type PP ShowP as Source # 
Instance details

Defined in Predicate

type PP ShowP as = String

data FormatTimeP p q Source #

type level expression representing a formatted time similar to formatTime using a type level Symbol to get the formatting string

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FormatTimeP "%F %T" Id) (read "2019-05-24 05:19:59" :: LocalTime)
Present "2019-05-24 05:19:59"
PresentT "2019-05-24 05:19:59"
>>> pl @(FormatTimeP Fst Snd) ("the date is %d/%m/%Y", read "2019-05-24" :: Day)
Present "the date is 24/05/2019"
PresentT "the date is 24/05/2019"
Instances
(PP p x ~ String, FormatTime (PP q x), P p x, Show (PP q x), P q x) => P (FormatTimeP p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FormatTimeP p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FormatTimeP p q) -> POpts -> x -> m (TT (PP (FormatTimeP p q) x)) Source #

type PP (FormatTimeP p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (FormatTimeP p q :: Type) x = String

data ParseTimeP' t p q Source #

similar to parseTimeM where 't' is the ParseTime type, 'p' is the datetime format and 'q' points to the content to parse

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ParseTimeP LocalTime "%F %T" Id) "2019-05-24 05:19:59"
Present 2019-05-24 05:19:59
PresentT 2019-05-24 05:19:59
>>> pl @(ParseTimeP LocalTime "%F %T" "2019-05-24 05:19:59") (Right "we ignore this using Symbol and not Id")
Present 2019-05-24 05:19:59
PresentT 2019-05-24 05:19:59

keeping 'q' as we might want to extract from a tuple

Instances
(ParseTime (PP t a), Typeable (PP t a), Show (PP t a), P p a, P q a, PP p a ~ String, PP q a ~ String) => P (ParseTimeP' t p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParseTimeP' t p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParseTimeP' t p q) -> POpts -> a -> m (TT (PP (ParseTimeP' t p q) a)) Source #

type PP (ParseTimeP' t p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ParseTimeP' t p q :: Type) a = PP t a

type ParseTimeP (t :: Type) p q = ParseTimeP' (Hole t) p q Source #

data ParseTimes' t p q Source #

A convenience method to match against many different datetime formats to find a match

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ParseTimes LocalTime '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"] "03/11/19 01:22:33") ()
Present 2019-03-11 01:22:33
PresentT 2019-03-11 01:22:33
>>> pl @(ParseTimes LocalTime Fst Snd) (["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"], "03/11/19 01:22:33")
Present 2019-03-11 01:22:33
PresentT 2019-03-11 01:22:33
Instances
(ParseTime (PP t a), Typeable (PP t a), Show (PP t a), P p a, P q a, PP p a ~ [String], PP q a ~ String) => P (ParseTimes' t p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParseTimes' t p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParseTimes' t p q) -> POpts -> a -> m (TT (PP (ParseTimes' t p q) a)) Source #

type PP (ParseTimes' t p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ParseTimes' t p q :: Type) a = PP t a

type ParseTimes (t :: Type) p q = ParseTimes' (Hole t) p q Source #

data MkDay p q r Source #

create a Day from three int values passed in as year month and day

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :set -XTypeOperators
>>> pl @(MkDay Fst (Snd >> Fst) (Snd >> Snd)) (2019,(12,30))
Present Just (2019-12-30,(1,1))
PresentT (Just (2019-12-30,(1,1)))
>>> pl @(MkDay Fst (Snd >> Fst) (Snd >> Snd)) (2019,(99,99999))
Present Nothing
PresentT Nothing
>>> pl @(MkDay Fst (Snd >> Fst) (Snd >> Snd)) (1999,(3,13))
Present Just (1999-03-13,(10,6))
PresentT (Just (1999-03-13,(10,6)))
Instances
(P p x, P q x, P r x, PP p x ~ Int, PP q x ~ Int, PP r x ~ Int) => P (MkDay p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkDay p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkDay p q r) -> POpts -> x -> m (TT (PP (MkDay p q r) x)) Source #

type PP (MkDay p q r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MkDay p q r :: Type) x = Maybe (Day, (Int, Int))

data UnMkDay Source #

uncreate a Day returning year month and day

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @UnMkDay (read "2019-12-30")
Present (2019,(12,30))
PresentT (2019,(12,30))
Instances
a ~ Day => P UnMkDay a Source # 
Instance details

Defined in Predicate

Associated Types

type PP UnMkDay a :: Type Source #

Methods

eval :: MonadEval m => Proxy UnMkDay -> POpts -> a -> m (TT (PP UnMkDay a)) Source #

type PP UnMkDay a Source # 
Instance details

Defined in Predicate

type PP UnMkDay a = (Int, (Int, Int))

data ReadP'' t p Source #

uses the Read of the given type 't' and 'p' which points to the content to read

>>> :set -XTypeApplications
>>> :set -XTypeOperators
>>> :set -XDataKinds
>>> pl @(ReadP Rational) "4 % 5"
Present 4 % 5
PresentT (4 % 5)
>>> pl @(ReadP' Day Id >> Between (ReadP' Day "2017-04-11") (ReadP' Day "2018-12-30")) "2018-10-12"
True
TrueT
>>> pl @(ReadP' Day Id >> Between (ReadP' Day "2017-04-11") (ReadP' Day "2018-12-30")) "2016-10-12"
False
FalseT
Instances
(P p x, PP p x ~ String, Typeable (PP t x), Show (PP t x), Read (PP t x)) => P (ReadP'' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadP'' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadP'' t p) -> POpts -> x -> m (TT (PP (ReadP'' t p) x)) Source #

type PP (ReadP'' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReadP'' t p :: Type) x = PP t x

type ReadP (t :: Type) = ReadP'' (Hole t) Id Source #

type ReadP' (t :: Type) p = ReadP'' (Hole t) p Source #

data Min Source #

similar to minimum

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Min [10,4,5,12,3,4]
Present 3
PresentT 3
>>> pl @Min []
Error empty list
FailT "empty list"
Instances
(Ord a, Show a) => P Min [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Min [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Min -> POpts -> [a] -> m (TT (PP Min [a])) Source #

type PP Min [a] Source # 
Instance details

Defined in Predicate

type PP Min [a] = a

data Max Source #

similar to maximum

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Max [10,4,5,12,3,4]
Present 12
PresentT 12
>>> pl @Max []
Error empty list
FailT "empty list"
Instances
(Ord a, Show a) => P Max [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Max [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Max -> POpts -> [a] -> m (TT (PP Max [a])) Source #

type PP Max [a] Source # 
Instance details

Defined in Predicate

type PP Max [a] = a

type Max' t = FoldMap (Max t) Id Source #

data SortBy p q Source #

sort a list

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(SortOn Fst Id) [(10,"abc"), (3,"def"), (4,"gg"), (10,"xyz"), (1,"z")]
Present [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
PresentT [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
Instances
(P p (a, a), P q x, Show a, PP q x ~ [a], PP p (a, a) ~ Ordering) => P (SortBy p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SortBy p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SortBy p q) -> POpts -> x -> m (TT (PP (SortBy p q) x)) Source #

type PP (SortBy p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (SortBy p q :: Type) x = PP q x

type SortOn p q = SortBy (OrdA p) q Source #

type SortOnDesc p q = SortBy (Swap >> OrdA p) q Source #

data Len Source #

similar to length

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Len [10,4,5,12,3,4]
Present 6
PresentT 6
>>> pl @Len []
Present 0
PresentT 0
Instances
(Show a, as ~ [a]) => P Len as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Len as :: Type Source #

Methods

eval :: MonadEval m => Proxy Len -> POpts -> as -> m (TT (PP Len as)) Source #

type PP Len as Source # 
Instance details

Defined in Predicate

type PP Len as = Int

data Length p Source #

similar to length for Foldable instances

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Length Id) (Left "aa")
Present 0
PresentT 0
>>> pl @(Length Id) (Right "aa")
Present 1
PresentT 1
>>> pl @(Length (Right' Id)) (Right "abcd")
Present 4
PresentT 4
Instances
(PP p x ~ t a, P p x, Show (t a), Foldable t) => P (Length p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Length p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Length p) -> POpts -> x -> m (TT (PP (Length p) x)) Source #

type PP (Length p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Length p :: Type) x = Int

data FstL' t p Source #

similar to _1

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FstL _ Id) (10,"Abc")
Present 10
PresentT 10
Instances
(PP p x ~ s, P p x, Show s, Field1 s s (PP t x) (PP t x), Show (PP t x)) => P (FstL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FstL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FstL' t p) -> POpts -> x -> m (TT (PP (FstL' t p) x)) Source #

type PP (FstL' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (FstL' t p :: Type) x = PP t x

type FstL (t :: Type) p = FstL' (Hole t) p Source #

data SndL' t p Source #

similar to _2

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(SndL _ Id) (10,"Abc")
Present "Abc"
PresentT "Abc"
Instances
(PP p x ~ s, P p x, Show s, Field2 s s (PP t x) (PP t x), Show (PP t x)) => P (SndL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SndL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SndL' t p) -> POpts -> x -> m (TT (PP (SndL' t p) x)) Source #

type PP (SndL' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (SndL' t p :: Type) x = PP t x

type SndL (t :: Type) p = SndL' (Hole t) p Source #

data ThdL' t p Source #

similar to _3

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ThdL _ Id) (10,"Abc",'x')
Present 'x'
PresentT 'x'
Instances
(PP p x ~ s, P p x, Show s, Field3 s s (PP t x) (PP t x), Show (PP t x)) => P (ThdL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ThdL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ThdL' t p) -> POpts -> x -> m (TT (PP (ThdL' t p) x)) Source #

type PP (ThdL' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ThdL' t p :: Type) x = PP t x

type ThdL (t :: Type) p = ThdL' (Hole t) p Source #

data FthL' t p Source #

similar to _4

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FthL _ Id) (10,"Abc",'x',True)
Present True
PresentT True
Instances
(PP p x ~ s, P p x, Show s, Field4 s s (PP t x) (PP t x), Show (PP t x)) => P (FthL' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FthL' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (FthL' t p) -> POpts -> x -> m (TT (PP (FthL' t p) x)) Source #

type PP (FthL' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (FthL' t p :: Type) x = PP t x

type FthL (t :: Type) p = FthL' (Hole t) p Source #

data Fst Source #

similar to fst

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Fst (10,"Abc")
Present 10
PresentT 10
Instances
(Show x, Show a) => P Fst (a, x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fst (a, x) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fst -> POpts -> (a, x) -> m (TT (PP Fst (a, x))) Source #

type PP Fst (a, x) Source # 
Instance details

Defined in Predicate

type PP Fst (a, x) = a

data Snd Source #

similar to snd

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Snd (10,"Abc")
Present "Abc"
PresentT "Abc"
Instances
(Show x, Show b) => P Snd (x, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Snd (x, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Snd -> POpts -> (x, b) -> m (TT (PP Snd (x, b))) Source #

type PP Snd (x, b) Source # 
Instance details

Defined in Predicate

type PP Snd (x, b) = b

data Fst3 Source #

fst for a 3-tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Fst3 (10,"Abc",True)
Present 10
PresentT 10
Instances
(Show x, Show y, Show a) => P Fst3 (a, x, y) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fst3 (a, x, y) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fst3 -> POpts -> (a, x, y) -> m (TT (PP Fst3 (a, x, y))) Source #

type PP Fst3 (a, x, y) Source # 
Instance details

Defined in Predicate

type PP Fst3 (a, x, y) = a

data Snd3 Source #

snd for a 3-tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Snd3 (10,"Abc",True)
Present "Abc"
PresentT "Abc"
Instances
(Show x, Show y, Show b) => P Snd3 (x, b, y) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Snd3 (x, b, y) :: Type Source #

Methods

eval :: MonadEval m => Proxy Snd3 -> POpts -> (x, b, y) -> m (TT (PP Snd3 (x, b, y))) Source #

type PP Snd3 (x, b, y) Source # 
Instance details

Defined in Predicate

type PP Snd3 (x, b, y) = b

data Thd3 Source #

access to third element in a 3-tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Thd3 (10,True,"Abc")
Present "Abc"
PresentT "Abc"
Instances
(Show x, Show y, Show b) => P Thd3 (x, y, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Thd3 (x, y, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Thd3 -> POpts -> (x, y, b) -> m (TT (PP Thd3 (x, y, b))) Source #

type PP Thd3 (x, y, b) Source # 
Instance details

Defined in Predicate

type PP Thd3 (x, y, b) = b

data I Source #

identity function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @I 23
Present 23
PresentT 23
Instances
P I a Source # 
Instance details

Defined in Predicate

Associated Types

type PP I a :: Type Source #

Methods

eval :: MonadEval m => Proxy I -> POpts -> a -> m (TT (PP I a)) Source #

type PP I a Source # 
Instance details

Defined in Predicate

type PP I a = a

data Id Source #

identity function that displays the input

even more constraints than I so we might need to add explicit type signatures

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Id 23
Present 23
PresentT 23
Instances
Show a => P Id a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Id a :: Type Source #

Methods

eval :: MonadEval m => Proxy Id -> POpts -> a -> m (TT (PP Id a)) Source #

type PP Id a Source # 
Instance details

Defined in Predicate

type PP Id a = a

data IdT Source #

identity function that also displays the type information for debugging

even more constraints than Id so we might need to explicitly add types (Typeable)

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @IdT 23
Present 23
PresentT 23
Instances
(Typeable a, Show a) => P IdT a Source # 
Instance details

Defined in Predicate

Associated Types

type PP IdT a :: Type Source #

Methods

eval :: MonadEval m => Proxy IdT -> POpts -> a -> m (TT (PP IdT a)) Source #

type PP IdT a Source # 
Instance details

Defined in Predicate

type PP IdT a = a

data FromStringP' t s Source #

fromString function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :set -XOverloadedStrings
>>> pl @(FromStringP (Identity _) Id) "abc"
Present Identity "abc"
PresentT (Identity "abc")
>>> pl @(FromStringP (Seq.Seq _) Id) "abc"
Present fromList "abc"
PresentT (fromList "abc")
Instances
(P s a, PP s a ~ String, Show (PP t a), IsString (PP t a)) => P (FromStringP' t s :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromStringP' t s) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromStringP' t s) -> POpts -> a -> m (TT (PP (FromStringP' t s) a)) Source #

type PP (FromStringP' t s :: Type) a Source # 
Instance details

Defined in Predicate

type PP (FromStringP' t s :: Type) a = PP t a

type FromStringP (t :: Type) p = FromStringP' (Hole t) p Source #

data FromInteger' t n Source #

fromInteger function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FromInteger (SG.Sum _) Id) 23
Present Sum {getSum = 23}
PresentT (Sum {getSum = 23})
Instances
(Num (PP t a), Integral (PP n a), P n a, Show (PP t a)) => P (FromInteger' t n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromInteger' t n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromInteger' t n) -> POpts -> a -> m (TT (PP (FromInteger' t n) a)) Source #

type PP (FromInteger' t n :: Type) a Source # 
Instance details

Defined in Predicate

type PP (FromInteger' t n :: Type) a = PP t a

type FromInteger (t :: Type) p = FromInteger' (Hole t) p Source #

data FromIntegral' t n Source #

fromIntegral function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FromIntegral (SG.Sum _) Id) 23
Present Sum {getSum = 23}
PresentT (Sum {getSum = 23})
Instances
(Num (PP t a), Integral (PP n a), P n a, Show (PP t a), Show (PP n a)) => P (FromIntegral' t n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromIntegral' t n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromIntegral' t n) -> POpts -> a -> m (TT (PP (FromIntegral' t n) a)) Source #

type PP (FromIntegral' t n :: Type) a Source # 
Instance details

Defined in Predicate

type PP (FromIntegral' t n :: Type) a = PP t a

type FromIntegral (t :: Type) p = FromIntegral' (Hole t) p Source #

data ToRational p Source #

toRational function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ToRational Id) 23.5
Present 47 % 2
PresentT (47 % 2)
Instances
(a ~ PP p x, Show a, Real a, P p x) => P (ToRational p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToRational p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToRational p) -> POpts -> x -> m (TT (PP (ToRational p) x)) Source #

type PP (ToRational p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ToRational p :: Type) x = Rational

data FromRational' t r Source #

fromRational function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(FromRational Rational Id) 23.5
Present 47 % 2
PresentT (47 % 2)
Instances
(P r a, PP r a ~ Rational, Show (PP t a), Fractional (PP t a)) => P (FromRational' t r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromRational' t r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromRational' t r) -> POpts -> a -> m (TT (PP (FromRational' t r) a)) Source #

type PP (FromRational' t r :: Type) a Source # 
Instance details

Defined in Predicate

type PP (FromRational' t r :: Type) a = PP t a

type FromRational (t :: Type) p = FromRational' (Hole t) p Source #

data Truncate' t p Source #

truncate function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Truncate Int Id) (23 % 5)
Present 4
PresentT 4
Instances
(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Truncate' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Truncate' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Truncate' t p) -> POpts -> x -> m (TT (PP (Truncate' t p) x)) Source #

type PP (Truncate' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Truncate' t p :: Type) x = PP t x

type Truncate (t :: Type) p = Truncate' (Hole t) p Source #

data Ceiling' t p Source #

ceiling function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Ceiling Int Id) (23 % 5)
Present 5
PresentT 5
Instances
(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Ceiling' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Ceiling' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Ceiling' t p) -> POpts -> x -> m (TT (PP (Ceiling' t p) x)) Source #

type PP (Ceiling' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Ceiling' t p :: Type) x = PP t x

type Ceiling (t :: Type) p = Ceiling' (Hole t) p Source #

data Floor' t p Source #

floor function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Floor Int Id) (23 % 5)
Present 4
PresentT 4
Instances
(Show (PP p x), P p x, Show (PP t x), RealFrac (PP p x), Integral (PP t x)) => P (Floor' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Floor' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Floor' t p) -> POpts -> x -> m (TT (PP (Floor' t p) x)) Source #

type PP (Floor' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Floor' t p :: Type) x = PP t x

type Floor (t :: Type) p = Floor' (Hole t) p Source #

data MkProxy Source #

converts a value to a Proxy: the same as '\'Proxy'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @MkProxy 'x'
Present Proxy
PresentT Proxy
Instances
Show a => P MkProxy a Source # 
Instance details

Defined in Predicate

Associated Types

type PP MkProxy a :: Type Source #

Methods

eval :: MonadEval m => Proxy MkProxy -> POpts -> a -> m (TT (PP MkProxy a)) Source #

type PP MkProxy a Source # 
Instance details

Defined in Predicate

type PP MkProxy a = Proxy a

type family DoExpandT (ps :: [k]) :: Type where ... Source #

Equations

DoExpandT '[] = TypeError (Text "'[] invalid: requires at least one predicate in the list") 
DoExpandT '[p] = Id >> p 
DoExpandT (p ': (p1 ': ps)) = p >> DoExpandT (p1 ': ps) 

data Do (ps :: [k]) Source #

processes a type level list predicates running each in sequence: see >>

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Do [Pred, ShowP, Id &&& Len]) 9876543
Present ("9876542",7)
PresentT ("9876542",7)
Instances
P (DoExpandT ps) a => P (Do ps :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Do ps) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Do ps) -> POpts -> a -> m (TT (PP (Do ps) a)) Source #

type PP (Do ps :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Do ps :: Type) a = PP (DoExpandT ps) a

data MaybeB b p Source #

Convenient method to convert a value 'p' to a Maybe based on a predicate '\b\' if '\b\' then Just 'p' else Nothing

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MaybeB (Id > 4) Id) 24
Present Just 24
PresentT (Just 24)
>>> pl @(MaybeB (Id > 4) Id) (-5)
Present Nothing
PresentT Nothing
Instances
(Show (PP p a), P b a, P p a, PP b a ~ Bool) => P (MaybeB b p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeB b p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeB b p) -> POpts -> a -> m (TT (PP (MaybeB b p) a)) Source #

type PP (MaybeB b p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (MaybeB b p :: Type) a = Maybe (PP p a)

data EitherB b p q Source #

Convenient method to convert a 'p' or '\q' to a Either based on a predicate '\b\' if 'b' then Right 'p' else Left '\q\'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(EitherB (Fst > 4) (Snd >> Fst) (Snd >> Snd)) (24,(-1,999))
Present Right 999
PresentT (Right 999)
>>> pl @(EitherB (Fst > 4) (Snd >> Fst) (Snd >> Snd)) (1,(-1,999))
Present Left (-1)
PresentT (Left (-1))
Instances
(Show (PP p a), P p a, Show (PP q a), P q a, P b a, PP b a ~ Bool) => P (EitherB b p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EitherB b p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (EitherB b p q) -> POpts -> a -> m (TT (PP (EitherB b p q) a)) Source #

type PP (EitherB b p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (EitherB b p q :: Type) a = Either (PP p a) (PP q a)

data TupleI (ps :: [k]) Source #

create inductive tuples from a type level list of predicates

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(TupleI '[Id,ShowP,Pred,W "str", W 999]) 666
Present (666,("666",(665,("str",(999,())))))
PresentT (666,("666",(665,("str",(999,())))))
Instances
P (TupleI ([] :: [k]) :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleI []) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleI []) -> POpts -> a -> m (TT (PP (TupleI []) a)) Source #

(P p a, P (TupleI ps) a, Show a) => P (TupleI (p ': ps) :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleI (p ': ps)) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleI (p ': ps)) -> POpts -> a -> m (TT (PP (TupleI (p ': ps)) a)) Source #

type PP (TupleI (p ': ps) :: Type) a Source # 
Instance details

Defined in Predicate

type PP (TupleI (p ': ps) :: Type) a = (PP p a, PP (TupleI ps) a)
type PP (TupleI ([] :: [k]) :: Type) a Source # 
Instance details

Defined in Predicate

type PP (TupleI ([] :: [k]) :: Type) a = ()

data Rat (pos :: Bool) (num :: Nat) (den :: Nat) Source #

type level representation of signed rational numbers/integers

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :set -XNoStarIsType
>>> pl @(NegR 14 3) ()
Present (-14) % 3
PresentT ((-14) % 3)
>>> pl @(PosR 14 3) ()
Present 14 % 3
PresentT (14 % 3)
>>> pl @(CmpRat (NegR 14 3) (Neg 5)) ()
Present GT
PresentT GT
>>> pl @(NegR 14 3 * Neg 5) ()
Present 70 % 3
PresentT (70 % 3)
>>> pl @(NegR 14 3 - Pos 5) ()
Present (-29) % 3
PresentT ((-29) % 3)
>>> pl @(CmpRat (PosR 14 3) 5) ()
Present LT
PresentT LT
Instances
(GetBool pos, KnownNat num, KnownNat den, NotZeroT den) => GetRat (Rat pos num den :: Type) Source # 
Instance details

Defined in Predicate

(GetBool pos, KnownNat num, KnownNat den, NotZeroT den) => P (Rat pos num den :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Rat pos num den) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Rat pos num den) -> POpts -> a -> m (TT (PP (Rat pos num den) a)) Source #

type PP (Rat pos num den :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Rat pos num den :: Type) a = Rational

type Pos (n :: Nat) = Rat True n 1 Source #

constructs a positive integer as a rational number Rat

type Neg (n :: Nat) = Rat False n 1 Source #

constructs a negative integer as a rational number Rat

type family PosR (n :: Nat) (d :: Nat) where ... Source #

constructs a valid positive rational number Rat

Equations

PosR n 0 = TypeError (Text "PosR has a 0 denominator where numerator=" :<>: ShowType n) 
PosR n d = Rat True n d 

type family NegR (n :: Nat) (d :: Nat) where ... Source #

constructs a valid negative rational number Rat

Equations

NegR n 0 = TypeError (Text "NegR has a 0 denominator where numerator=" :<>: ShowType n) 
NegR n d = Rat False n d 

type family CmpRat (m :: k) (n :: k1) :: Ordering where ... Source #

compares 2 numbers where the numbers are type level signed rationals or Nats

Equations

CmpRat (Rat x n 0) z = TypeError (Text "CmpRat: lhs has 0 denominator" :$$: ((ShowType (Rat x n 0) :<>: Text " `CmpRat` ") :<>: ShowType z)) 
CmpRat z (Rat x n 0) = TypeError (Text "CmpRat: rhs has 0 denominator" :$$: ((ShowType z :<>: Text " `CmpRat` ") :<>: ShowType (Rat x n 0))) 
CmpRat (m :: Nat) (n :: Nat) = CmpNat m n 
CmpRat (Rat x n d) (w :: Nat) = CmpRat (Rat x n d) (Pos w) 
CmpRat (w :: Nat) (Rat x n d) = CmpRat (Pos w) (Rat x n d) 
CmpRat (Rat x 0 d) (Rat x1 0 d1) = EQ 
CmpRat (Rat True n d) (Rat False n1 d1) = GT 
CmpRat (Rat False n d) (Rat True n1 d1) = LT 
CmpRat (Rat False n d) (Rat False n1 d1) = CmpRat (Rat True n1 d1) (Rat True n d) 
CmpRat (Rat True n d) (Rat True n1 d1) = IfT (CmpNat (Div n d) (Div n1 d1) == EQ) (CmpNat (n * d1) (n1 * d)) (CmpNat (Div n d) (Div n1 d1)) 

class GetRats as where Source #

get a list of Rationals from the type level

Methods

getRats :: [Rational] Source #

Instances
GetRats ([] :: [k]) Source # 
Instance details

Defined in Predicate

Methods

getRats :: [Rational] Source #

(GetRat n, GetRats ns) => GetRats (n ': ns :: [a]) Source # 
Instance details

Defined in Predicate

Methods

getRats :: [Rational] Source #

class GetRat a where Source #

get a Rational from the type level

Instances
KnownNat n => GetRat (n :: Nat) Source # 
Instance details

Defined in Predicate

(GetBool pos, KnownNat num, KnownNat den, NotZeroT den) => GetRat (Rat pos num den :: Type) Source # 
Instance details

Defined in Predicate

data Msg prt p Source #

add a message to give more context to the evaluation tree

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pe @(Msg' "somemessage" Id) 999
P [somemessage] Id 999
PresentT 999
Instances
(P prt a, PP prt a ~ String, P p a) => P (Msg prt p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Msg prt p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Msg prt p) -> POpts -> a -> m (TT (PP (Msg prt p) a)) Source #

type PP (Msg prt p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Msg prt p :: Type) a = PP p a

type Msg' prt p = Msg (Printf "[%s] " prt) p Source #

data Pad (left :: Bool) n p q Source #

pad 'q' with '\n' values from '\p'\

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(PadL 5 999 Id) [12,13]
Present [999,999,999,12,13]
PresentT [999,999,999,12,13]
>>> pl @(PadR 5 Fst '[12,13]) (999,'x')
Present [12,13,999,999,999]
PresentT [12,13,999,999,999]
>>> pl @(PadR 2 Fst '[12,13,14]) (999,'x')
Present [12,13,14]
PresentT [12,13,14]
Instances
(P n a, GetBool left, Integral (PP n a), [PP p a] ~ PP q a, P p a, P q a, Show (PP p a)) => P (Pad left n p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pad left n p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pad left n p q) -> POpts -> a -> m (TT (PP (Pad left n p q) a)) Source #

type PP (Pad left n p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Pad left n p q :: Type) a = PP q a

type PadL n p q = Pad True n p q Source #

type PadR n p q = Pad False n p q Source #

data SplitAts ns p Source #

split a list 'p' into parts using the lengths in the type level list 'ns'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(SplitAts '[2,3,1,1] Id) "hello world"
Present ["he","llo"," ","w","orld"]
PresentT ["he","llo"," ","w","orld"]
>>> pl @(SplitAts '[2] Id) "hello world"
Present ["he","llo world"]
PresentT ["he","llo world"]
>>> pl @(SplitAts '[10,1,1,5] Id) "hello world"
Present ["hello worl","d","",""]
PresentT ["hello worl","d","",""]
Instances
(P ns x, P p x, PP p x ~ [a], Show n, Show a, PP ns x ~ [n], Integral n) => P (SplitAts ns p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SplitAts ns p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (SplitAts ns p) -> POpts -> x -> m (TT (PP (SplitAts ns p) x)) Source #

type PP (SplitAts ns p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (SplitAts ns p :: Type) x = [PP p x]

data SplitAt n p Source #

similar to splitAt

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(SplitAt 4 Id) "hello world"
Present ("hell","o world")
PresentT ("hell","o world")
>>> pl @(SplitAt 20 Id) "hello world"
Present ("hello world","")
PresentT ("hello world","")
>>> pl @(SplitAt 0 Id) "hello world"
Present ("","hello world")
PresentT ("","hello world")
>>> pl @(SplitAt Snd Fst) ("hello world",4)
Present ("hell","o world")
PresentT ("hell","o world")
Instances
(PP p a ~ [b], P n a, P p a, Show b, Integral (PP n a)) => P (SplitAt n p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SplitAt n p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (SplitAt n p) -> POpts -> a -> m (TT (PP (SplitAt n p) a)) Source #

type PP (SplitAt n p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (SplitAt n p :: Type) a = (PP p a, PP p a)

type Take n p = SplitAt n p >> Fst Source #

type Drop n p = SplitAt n p >> Snd Source #

type (&&&) p q = W '(p, q) infixr 3 Source #

similar to &&&

data (p :: k) *** (q :: k1) infixr 3 Source #

similar to ***

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Pred *** ShowP) (13, True)
Present (12,"True")
PresentT (12,"True")
Instances
(Show (PP p a), Show (PP q b), P p a, P q b, Show a, Show b) => P (p *** q :: Type) (a, b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p *** q) (a, b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p *** q) -> POpts -> (a, b) -> m (TT (PP (p *** q) (a, b))) Source #

type PP (p *** q :: Type) (a, b) Source # 
Instance details

Defined in Predicate

type PP (p *** q :: Type) (a, b) = (PP p a, PP q b)

type Star p q = p *** q Source #

type First p = Star p I Source #

type Second q = Star I q Source #

data (p :: k) ||| (q :: k1) infixr 2 Source #

similar |||

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Pred ||| Id) (Left 13)
Present 12
PresentT 12
>>> pl @(ShowP ||| Id) (Right "hello")
Present "hello"
PresentT "hello"
Instances
(Show (PP p a), P p a, P q b, PP p a ~ PP q b, Show a, Show b) => P (p ||| q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p ||| q) (Either a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ||| q) -> POpts -> Either a b -> m (TT (PP (p ||| q) (Either a b))) Source #

type PP (p ||| q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

type PP (p ||| q :: Type) (Either a b) = PP p a

type EitherIn p q = p ||| q Source #

data (p :: k) +++ (q :: k1) infixr 2 Source #

similar +++

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Pred +++ Id) (Left 13)
Present Left 12
PresentT (Left 12)
>>> pl @(ShowP +++ Reverse) (Right "hello")
Present Right "olleh"
PresentT (Right "olleh")
Instances
(Show (PP p a), Show (PP q b), P p a, P q b, Show a, Show b) => P (p +++ q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p +++ q) (Either a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (p +++ q) -> POpts -> Either a b -> m (TT (PP (p +++ q) (Either a b))) Source #

type PP (p +++ q :: Type) (Either a b) Source # 
Instance details

Defined in Predicate

type PP (p +++ q :: Type) (Either a b) = Either (PP p a) (PP q b)

type Dup = '(Id, Id) Source #

data BinOp Source #

Constructors

BMult 
BSub 
BAdd 
Instances
Eq BinOp Source # 
Instance details

Defined in Predicate

Methods

(==) :: BinOp -> BinOp -> Bool #

(/=) :: BinOp -> BinOp -> Bool #

Show BinOp Source # 
Instance details

Defined in Predicate

Methods

showsPrec :: Int -> BinOp -> ShowS #

show :: BinOp -> String #

showList :: [BinOp] -> ShowS #

type Mult p q = Bin BMult p q Source #

type Add p q = Bin BAdd p q Source #

type Sub p q = Bin BSub p q Source #

type (+) p q = Add p q infixl 6 Source #

type (-) p q = Sub p q infixl 6 Source #

type * p q = Mult p q infixl 7 Source #

type (>) p q = Cmp Cgt p q infix 4 Source #

type (>=) p q = Cmp Cge p q infix 4 Source #

type (==) p q = Cmp Ceq p q infix 4 Source #

type (/=) p q = Cmp Cne p q infix 4 Source #

type (<=) p q = Cmp Cle p q infix 4 Source #

type (<) p q = Cmp Clt p q infix 4 Source #

type (>?) p q = CmpI Cgt p q infix 4 Source #

type (>=?) p q = CmpI Cge p q infix 4 Source #

type (==?) p q = CmpI Ceq p q infix 4 Source #

type (/=?) p q = CmpI Cne p q infix 4 Source #

type (<=?) p q = CmpI Cle p q infix 4 Source #

type (<?) p q = CmpI Clt p q infix 4 Source #

class GetBinOp (k :: BinOp) where Source #

Methods

getBinOp :: (Num a, a ~ b) => (String, a -> b -> a) Source #

Instances
GetBinOp BMult Source # 
Instance details

Defined in Predicate

Methods

getBinOp :: (Num a, a ~ b) => (String, a -> b -> a) Source #

GetBinOp BSub Source # 
Instance details

Defined in Predicate

Methods

getBinOp :: (Num a, a ~ b) => (String, a -> b -> a) Source #

GetBinOp BAdd Source # 
Instance details

Defined in Predicate

Methods

getBinOp :: (Num a, a ~ b) => (String, a -> b -> a) Source #

data Bin (op :: BinOp) p q Source #

addition, multiplication and subtraction

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :set -XNoStarIsType
>>> pl @(Fst * Snd) (13,5)
Present 65
PresentT 65
>>> pl @(Fst + 4 * (Snd >> Len) - 4) (3,"hello")
Present 19
PresentT 19
Instances
(GetBinOp op, PP p a ~ PP q a, P p a, P q a, Show (PP p a), Num (PP p a)) => P (Bin op p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Bin op p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Bin op p q) -> POpts -> a -> m (TT (PP (Bin op p q) a)) Source #

type PP (Bin op p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Bin op p q :: Type) a = PP p a

data DivF p q Source #

fractional division

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst / Snd) (13,2)
Present 6.5
PresentT 6.5
>>> pl @(Pos 13 / Id) 0
Error DivF zero denominator
FailT "DivF zero denominator"
Instances
(PP p a ~ PP q a, Eq (PP q a), P p a, P q a, Show (PP p a), Fractional (PP p a)) => P (DivF p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (DivF p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (DivF p q) -> POpts -> a -> m (TT (PP (DivF p q) a)) Source #

type PP (DivF p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (DivF p q :: Type) a = PP p a

type (/) p q = DivF p q infixl 7 Source #

data Negate Source #

similar to negate

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Negate 14
Present -14
PresentT (-14)
Instances
(Show a, Num a) => P Negate a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Negate a :: Type Source #

Methods

eval :: MonadEval m => Proxy Negate -> POpts -> a -> m (TT (PP Negate a)) Source #

type PP Negate a Source # 
Instance details

Defined in Predicate

type PP Negate a = a

data Abs Source #

similar to abs

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Abs (-14)
Present 14
PresentT 14
>>> pl @Abs 14
Present 14
PresentT 14
>>> pl @Abs 0
Present 0
PresentT 0
Instances
(Show a, Num a) => P Abs a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Abs a :: Type Source #

Methods

eval :: MonadEval m => Proxy Abs -> POpts -> a -> m (TT (PP Abs a)) Source #

type PP Abs a Source # 
Instance details

Defined in Predicate

type PP Abs a = a

data Signum Source #

similar to signum

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Signum (-14)
Present -1
PresentT (-1)
>>> pl @Signum 14
Present 1
PresentT 1
>>> pl @Signum 0
Present 0
PresentT 0
Instances
(Show a, Num a) => P Signum a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Signum a :: Type Source #

Methods

eval :: MonadEval m => Proxy Signum -> POpts -> a -> m (TT (PP Signum a)) Source #

type PP Signum a Source # 
Instance details

Defined in Predicate

type PP Signum a = a

data Unwrap Source #

unwraps a value (see Wrapped)

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Unwrap (SG.Sum (-13))
Present -13
PresentT (-13)
Instances
(Show s, Show (Unwrapped s), Wrapped s) => P Unwrap s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unwrap s :: Type Source #

Methods

eval :: MonadEval m => Proxy Unwrap -> POpts -> s -> m (TT (PP Unwrap s)) Source #

type PP Unwrap s Source # 
Instance details

Defined in Predicate

type PP Unwrap s = Unwrapped s

data Wrap' t p Source #

wraps a value (see Wrapped and Wrapped)

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> :m + Data.List.NonEmpty
>>> pl @(Wrap (SG.Sum _) Id) (-13)
Present Sum {getSum = -13}
PresentT (Sum {getSum = -13})
>>> pl @(Wrap SG.Any (Ge 4)) 13
Present Any {getAny = True}
PresentT (Any {getAny = True})
>>> pl @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"
Present 'a' :| "bcd"
PresentT ('a' :| "bcd")
Instances
(Show (PP p x), P p x, Unwrapped (PP s x) ~ PP p x, Wrapped (PP s x), Show (PP s x)) => P (Wrap' s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Wrap' s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Wrap' s p) -> POpts -> x -> m (TT (PP (Wrap' s p) x)) Source #

type PP (Wrap' s p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Wrap' s p :: Type) x = PP s x

type Wrap (t :: Type) p = Wrap' (Hole t) p Source #

data Coerce (t :: k) Source #

similar to coerce

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Coerce (SG.Sum Integer)) (Identity (-13))
Present Sum {getSum = -13}
PresentT (Sum {getSum = -13})
Instances
(Show a, Show t, Coercible t a) => P (Coerce t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Coerce t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Coerce t) -> POpts -> a -> m (TT (PP (Coerce t) a)) Source #

type PP (Coerce t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Coerce t :: Type) a = t

data Coerce2 (t :: k) Source #

see Coerce: coerce over a functor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Coerce2 (SG.Sum Integer)) [Identity (-13), Identity 4, Identity 99]
Present [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
PresentT [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
>>> pl @(Coerce2 (SG.Sum Integer)) (Just (Identity (-13)))
Present Just (Sum {getSum = -13})
PresentT (Just (Sum {getSum = -13}))
>>> pl @(Coerce2 (SG.Sum Int)) (Nothing @(Identity Int))
Present Nothing
PresentT Nothing
Instances
(Show (f a), Show (f t), Coercible t a, Functor f) => P (Coerce2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Coerce2 t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Coerce2 t) -> POpts -> f a -> m (TT (PP (Coerce2 t) (f a))) Source #

type PP (Coerce2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

type PP (Coerce2 t :: Type) (f a) = f t

data MemptyT2' t Source #

lift mempty over a Functor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MemptyT2 (SG.Product Int)) [Identity (-13), Identity 4, Identity 99]
Present [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
PresentT [Product {getProduct = 1},Product {getProduct = 1},Product {getProduct = 1}]
Instances
(Show (f a), Show (f (PP t (f a))), Functor f, Monoid (PP t (f a))) => P (MemptyT2' t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MemptyT2' t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (MemptyT2' t) -> POpts -> f a -> m (TT (PP (MemptyT2' t) (f a))) Source #

type PP (MemptyT2' t :: Type) (f a) Source # 
Instance details

Defined in Predicate

type PP (MemptyT2' t :: Type) (f a) = f (PP t (f a))

data Pure2 (t :: Type -> Type) Source #

lift pure over a Functor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Pure2 (Either String)) [1,2,4]
Present [Right 1,Right 2,Right 4]
PresentT [Right 1,Right 2,Right 4]
Instances
(Show (f (t a)), Show (f a), Applicative t, Functor f) => P (Pure2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pure2 t) (f a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pure2 t) -> POpts -> f a -> m (TT (PP (Pure2 t) (f a))) Source #

type PP (Pure2 t :: Type) (f a) Source # 
Instance details

Defined in Predicate

type PP (Pure2 t :: Type) (f a) = f (t a)

type Right t = Pure (Either t) Id Source #

type Left t = Right t >> Swap Source #

data Reverse Source #

similar to reverse

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Reverse [1,2,4]
Present [4,2,1]
PresentT [4,2,1]
>>> pl @Reverse "AbcDeF"
Present "FeDcbA"
PresentT "FeDcbA"
Instances
(Show a, as ~ [a]) => P Reverse as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Reverse as :: Type Source #

Methods

eval :: MonadEval m => Proxy Reverse -> POpts -> as -> m (TT (PP Reverse as)) Source #

type PP Reverse as Source # 
Instance details

Defined in Predicate

type PP Reverse as = as

data ReverseL Source #

reverses using reversing

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> import Data.Text (Text)
>>> pl @ReverseL ("AbcDeF" :: Text)
Present "FeDcbA"
PresentT "FeDcbA"
Instances
(Show t, Reversing t) => P ReverseL t Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReverseL t :: Type Source #

Methods

eval :: MonadEval m => Proxy ReverseL -> POpts -> t -> m (TT (PP ReverseL t)) Source #

type PP ReverseL t Source # 
Instance details

Defined in Predicate

type PP ReverseL t = t

data Swap Source #

swaps using swapped

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Swap (Left 123)
Present Right 123
PresentT (Right 123)
>>> pl @Swap (Right 123)
Present Left 123
PresentT (Left 123)
>>> pl @Swap (These 'x' 123)
Present These 123 'x'
PresentT (These 123 'x')
>>> pl @Swap (This 'x')
Present That 'x'
PresentT (That 'x')
>>> pl @Swap (That 123)
Present This 123
PresentT (This 123)
>>> pl @Swap (123,'x')
Present ('x',123)
PresentT ('x',123)
Instances
(Show (p a b), Swapped p, Show (p b a)) => P Swap (p a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Swap (p a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy Swap -> POpts -> p a b -> m (TT (PP Swap (p a b))) Source #

type PP Swap (p a b) Source # 
Instance details

Defined in Predicate

type PP Swap (p a b) = p b a

data SuccB def Source #

bounded succ function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @SuccB' (13 :: Int)
Present 14
PresentT 14
>>> pl @SuccB' LT
Present EQ
PresentT EQ
>>> pl @(SuccB 'LT) GT
Present LT
PresentT LT
>>> pl @SuccB' GT
Error Succ bounded failed
FailT "Succ bounded failed"
Instances
(P def (Proxy a), PP def (Proxy a) ~ a, Show a, Eq a, Bounded a, Enum a) => P (SuccB def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (SuccB def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (SuccB def) -> POpts -> a -> m (TT (PP (SuccB def) a)) Source #

type PP (SuccB def :: Type) a Source # 
Instance details

Defined in Predicate

type PP (SuccB def :: Type) a = a

type SuccB' = SuccB (Failp "Succ bounded failed") Source #

data PredB def Source #

bounded pred function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @PredB' (13 :: Int)
Present 12
PresentT 12
Instances
(P def (Proxy a), PP def (Proxy a) ~ a, Show a, Eq a, Bounded a, Enum a) => P (PredB def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (PredB def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (PredB def) -> POpts -> a -> m (TT (PP (PredB def) a)) Source #

type PP (PredB def :: Type) a Source # 
Instance details

Defined in Predicate

type PP (PredB def :: Type) a = a

type PredB' = PredB (Failp "Pred bounded failed") Source #

data Succ Source #

unbounded succ function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Succ 13
Present 14
PresentT 14
>>> pl @Succ LT
Present EQ
PresentT EQ
>>> pl @Succ GT
Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument
FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument"
Instances
(Show a, Enum a) => P Succ a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Succ a :: Type Source #

Methods

eval :: MonadEval m => Proxy Succ -> POpts -> a -> m (TT (PP Succ a)) Source #

type PP Succ a Source # 
Instance details

Defined in Predicate

type PP Succ a = a

data Pred Source #

unbounded pred function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Pred 13
Present 12
PresentT 12
Instances
(Show a, Enum a) => P Pred a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Pred a :: Type Source #

Methods

eval :: MonadEval m => Proxy Pred -> POpts -> a -> m (TT (PP Pred a)) Source #

type PP Pred a Source # 
Instance details

Defined in Predicate

type PP Pred a = a

data FromEnum Source #

fromEnum function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @FromEnum 'x'
Present 120
PresentT 120
Instances
(Show a, Enum a) => P FromEnum a Source # 
Instance details

Defined in Predicate

Associated Types

type PP FromEnum a :: Type Source #

Methods

eval :: MonadEval m => Proxy FromEnum -> POpts -> a -> m (TT (PP FromEnum a)) Source #

type PP FromEnum a Source # 
Instance details

Defined in Predicate

type PP FromEnum a = Int

data ToEnum' t Source #

unsafe toEnum function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ToEnum Char) 120
Present 'x'
PresentT 'x'
Instances
(Show a, Enum (PP t a), Show (PP t a), Integral a) => P (ToEnum' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToEnum' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToEnum' t) -> POpts -> a -> m (TT (PP (ToEnum' t) a)) Source #

type PP (ToEnum' t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ToEnum' t :: Type) a = PP t a

type ToEnum (t :: Type) = ToEnum' (Hole t) Source #

data ToEnumB' t def Source #

bounded toEnum function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ToEnumB Ordering LT) 2
Present GT
PresentT GT
>>> pl @(ToEnumB Ordering LT) 6
Present LT
PresentT LT
>>> pl @(ToEnumBF Ordering) 6
Error ToEnum bounded failed
FailT "ToEnum bounded failed"
Instances
(P def (Proxy (PP t a)), PP def (Proxy (PP t a)) ~ PP t a, Show a, Show (PP t a), Bounded (PP t a), Enum (PP t a), Integral a) => P (ToEnumB' t def :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ToEnumB' t def) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ToEnumB' t def) -> POpts -> a -> m (TT (PP (ToEnumB' t def) a)) Source #

type PP (ToEnumB' t def :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ToEnumB' t def :: Type) a = PP t a

type ToEnumB (t :: Type) def = ToEnumB' (Hole t) def Source #

type ToEnumBF (t :: Type) = ToEnumB' (Hole t) (Failp "ToEnum bounded failed") Source #

data Prime Source #

a predicate on prime numbers

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Prime 2
True
TrueT
>>> pl @(Map '(Id,Prime) Id) [0..12]
Present [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
PresentT [(0,False),(1,False),(2,True),(3,True),(4,False),(5,True),(6,False),(7,True),(8,False),(9,False),(10,False),(11,True),(12,False)]
Instances
(Show a, Integral a) => P Prime a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Prime a :: Type Source #

Methods

eval :: MonadEval m => Proxy Prime -> POpts -> a -> m (TT (PP Prime a)) Source #

type PP Prime a Source # 
Instance details

Defined in Predicate

type PP Prime a = Bool

data Not Source #

not function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Not False
True
TrueT
>>> pl @Not True
False
FalseT
Instances
a ~ Bool => P Not a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Not a :: Type Source #

Methods

eval :: MonadEval m => Proxy Not -> POpts -> a -> m (TT (PP Not a)) Source #

type PP Not a Source # 
Instance details

Defined in Predicate

type PP Not a = Bool

data KeepImpl (keep :: Bool) p q Source #

filters a list 'q' keeping or removing those elements in 'p'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Keep '[5] '[1,5,5,2,5,2]) ()
Present [5,5,5]
PresentT [5,5,5]
>>> pl @(Keep '[0,1,1,5] '[1,5,5,2,5,2]) ()
Present [1,5,5,5]
PresentT [1,5,5,5]
>>> pl @(Remove '[5] '[1,5,5,2,5,2]) ()
Present [1,2,2]
PresentT [1,2,2]
>>> pl @(Remove '[0,1,1,5] '[1,5,5,2,5,2]) ()
Present [2,2]
PresentT [2,2]
>>> pl @(Remove '[99] '[1,5,5,2,5,2]) ()
Present [1,5,5,2,5,2]
PresentT [1,5,5,2,5,2]
>>> pl @(Remove '[99,91] '[1,5,5,2,5,2]) ()
Present [1,5,5,2,5,2]
PresentT [1,5,5,2,5,2]
>>> pl @(Remove Id '[1,5,5,2,5,2]) []
Present [1,5,5,2,5,2]
PresentT [1,5,5,2,5,2]
>>> pl @(Remove '[] '[1,5,5,2,5,2]) 44 -- works if you make this a number!
Present [1,5,5,2,5,2]
PresentT [1,5,5,2,5,2]
Instances
(GetBool keep, Eq a, Show a, P p x, P q x, PP p x ~ PP q x, PP q x ~ [a]) => P (KeepImpl keep p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (KeepImpl keep p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (KeepImpl keep p q) -> POpts -> x -> m (TT (PP (KeepImpl keep p q) x)) Source #

type PP (KeepImpl keep p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (KeepImpl keep p q :: Type) x = PP q x

type Remove p q = KeepImpl False p q Source #

type Keep p q = KeepImpl True p q Source #

data Elem p q Source #

elem function

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Elem Fst Snd) ('x',"abcdxy")
True
TrueT
>>> pl @(Elem Fst Snd) ('z',"abcdxy")
False
FalseT
Instances
([PP p a] ~ PP q a, P p a, P q a, Show (PP p a), Eq (PP p a)) => P (Elem p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Elem p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Elem p q) -> POpts -> a -> m (TT (PP (Elem p q) a)) Source #

type PP (Elem p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Elem p q :: Type) a = Bool

type ElemAll p q = Any (Elem I q) Source #

type Head' p = HeadFail "Head(empty)" p Source #

type Tail' p = TailFail "Tail(empty)" p Source #

type Last' p = LastFail "Last(empty)" p Source #

type Init' p = InitFail "Init(empty)" p Source #

data Fmap_1 Source #

similar to fmap fst

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Fmap_1 (Just (13,"Asf"))
Present Just 13
PresentT (Just 13)

to make this work we grab the fst or snd out of the Maybe so it is a head or not/ is a tail or not etc! we still have access to the whole original list so we dont lose anything!

Instances
Functor f => P Fmap_1 (f (a, x)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fmap_1 (f (a, x)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fmap_1 -> POpts -> f (a, x) -> m (TT (PP Fmap_1 (f (a, x)))) Source #

type PP Fmap_1 (f (a, x)) Source # 
Instance details

Defined in Predicate

type PP Fmap_1 (f (a, x)) = f a

data Fmap_2 Source #

similar to fmap snd

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Fmap_2 (Just ("asf",13))
Present Just 13
PresentT (Just 13)
Instances
Functor f => P Fmap_2 (f (x, a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Fmap_2 (f (x, a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Fmap_2 -> POpts -> f (x, a) -> m (TT (PP Fmap_2 (f (x, a)))) Source #

type PP Fmap_2 (f (x, a)) Source # 
Instance details

Defined in Predicate

type PP Fmap_2 (f (x, a)) = f a

type HeadDef p q = GDef (Uncons >> Fmap_1) p q Source #

type HeadFail msg q = GFail (Uncons >> Fmap_1) msg q Source #

type TailDef p q = GDef (Uncons >> Fmap_2) p q Source #

type TailFail msg q = GFail (Uncons >> Fmap_2) msg q Source #

type LastDef p q = GDef (Unsnoc >> Fmap_2) p q Source #

type LastFail msg q = GFail (Unsnoc >> Fmap_2) msg q Source #

type InitDef p q = GDef (Unsnoc >> Fmap_1) p q Source #

type InitFail msg q = GFail (Unsnoc >> Fmap_1) msg q Source #

type GDef' z p q r = '(I, r >> z) >> MaybeXP (X >> p) q Snd Source #

type JustDef' p q r = GDef' I p q r Source #

type GDef'' z p q r = '(I, r >> z) >> MaybeXP p q Snd Source #

type JustDef'' p q r = GDef'' I p q r Source #

type PA = Snd Source #

type A = Snd Source #

type X = Fst >> Fst Source #

type XA = I Source #

type XPA = I Source #

type GDef_X z p q r = '(I, r >> z) >> MaybeXP (X >> p) ('(X, A) >> q) A Source #

type JustDef''' p q r = GDef_X I p q r Source #

type GDef_PA z p q r = (Hide % '(I, r >> z)) >> MaybeXP (PA >> p) ('(X, A) >> q) A Source #

type GDef z p q = '(I, q >> z) >> MaybeXP (X >> p) A A Source #

type GProxy z q = '(I, q >> z) >> MaybeXP (PA >> MemptyP) A A Source #

type GFail z msg q = '(I, q >> z) >> MaybeXP (Fail (PA >> Unproxy) (X >> msg)) A A Source #

type LookupDef' x y p q = GDef (Lookup x y) p q Source #

type LookupP' x y q = GProxy (Lookup x y) q Source #

type LookupFail' msg x y q = GFail (Lookup x y) msg q Source #

type LookupDef x y p = LookupDef' x y p I Source #

type LookupP x y = LookupP' x y I Source #

type LookupFail msg x y = LookupFail' msg x y I Source #

type Just' p = JustFail "expected Just" p Source #

type Left' p = LeftFail "expected Left" p Source #

type Right' p = RightFail "expected Right" p Source #

type This' p = ThisFail "expected This" p Source #

type That' p = ThatFail "expected That" p Source #

type TheseIn' p = TheseFail "expected These" p Source #

type JustDef p q = GDef I p q Source #

type JustP q = GProxy I q Source #

type JustFail msg q = GFail I msg q Source #

type LeftFail msg q = GFail LeftToMaybe msg q Source #

type RightFail msg q = GFail RightToMaybe msg q Source #

type ThisFail msg q = GFail ThisToMaybe msg q Source #

type ThatFail msg q = GFail ThatToMaybe msg q Source #

type TheseFail msg q = GFail TheseToMaybe msg q Source #

data MaybeXP p q r Source #

Instances
(P r x, P p (x, Proxy a), P q (x, a), PP r x ~ Maybe a, PP p (x, Proxy a) ~ b, PP q (x, a) ~ b) => P (MaybeXP p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeXP p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeXP p q r) -> POpts -> x -> m (TT (PP (MaybeXP p q r) x)) Source #

type PP (MaybeXP p q r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MaybeXP p q r :: Type) x = MaybeXPT (PP r x) x q

type MaybeX p q r = MaybeXP (Fst >> p) q r Source #

type family MaybeXPT lr x q where ... Source #

Equations

MaybeXPT (Maybe a) x q = PP q (x, a) 

data LeftToMaybe Source #

similar to either Just (const Nothing)

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @LeftToMaybe (Left 13)
Present Just 13
PresentT (Just 13)
>>> pl @LeftToMaybe (Right 13)
Present Nothing
PresentT Nothing
Instances
P LeftToMaybe (Either a x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP LeftToMaybe (Either a x) :: Type Source #

Methods

eval :: MonadEval m => Proxy LeftToMaybe -> POpts -> Either a x -> m (TT (PP LeftToMaybe (Either a x))) Source #

type PP LeftToMaybe (Either a x) Source # 
Instance details

Defined in Predicate

type PP LeftToMaybe (Either a x) = Maybe a

data RightToMaybe Source #

similar to either (const Nothing) Just

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @RightToMaybe (Right 13)
Present Just 13
PresentT (Just 13)
>>> pl @RightToMaybe (Left 13)
Present Nothing
PresentT Nothing
Instances
P RightToMaybe (Either x a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP RightToMaybe (Either x a) :: Type Source #

Methods

eval :: MonadEval m => Proxy RightToMaybe -> POpts -> Either x a -> m (TT (PP RightToMaybe (Either x a))) Source #

type PP RightToMaybe (Either x a) Source # 
Instance details

Defined in Predicate

type PP RightToMaybe (Either x a) = Maybe a

data ThisToMaybe Source #

Instances
P ThisToMaybe (These a x) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ThisToMaybe (These a x) :: Type Source #

Methods

eval :: MonadEval m => Proxy ThisToMaybe -> POpts -> These a x -> m (TT (PP ThisToMaybe (These a x))) Source #

type PP ThisToMaybe (These a x) Source # 
Instance details

Defined in Predicate

type PP ThisToMaybe (These a x) = Maybe a

data ThatToMaybe Source #

Instances
P ThatToMaybe (These x a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ThatToMaybe (These x a) :: Type Source #

Methods

eval :: MonadEval m => Proxy ThatToMaybe -> POpts -> These x a -> m (TT (PP ThatToMaybe (These x a))) Source #

type PP ThatToMaybe (These x a) Source # 
Instance details

Defined in Predicate

type PP ThatToMaybe (These x a) = Maybe a

data TheseToMaybe Source #

Instances
P TheseToMaybe (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP TheseToMaybe (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy TheseToMaybe -> POpts -> These a b -> m (TT (PP TheseToMaybe (These a b))) Source #

type PP TheseToMaybe (These a b) Source # 
Instance details

Defined in Predicate

type PP TheseToMaybe (These a b) = Maybe (a, b)

data EitherX p q r Source #

similar to ||| but additionally gives 'p' and 'q' the original input

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(EitherX (((Fst >> Fst) + Snd) >> ShowP) ShowP Snd) (9,Left 123)
Present "132"
PresentT "132"
>>> pl @(EitherX (((Fst >> Fst) + Snd) >> ShowP) ShowP Snd) (9,Right 'x')
Present "((9,Right 'x'),'x')"
PresentT "((9,Right 'x'),'x')"
>>> pl @(EitherX ShowP (Second Succ >> ShowP) Snd) (9,Right 'x')
Present "((9,Right 'x'),'y')"
PresentT "((9,Right 'x'),'y')"
Instances
(P r x, P p (x, a), P q (x, b), PP r x ~ Either a b, PP p (x, a) ~ c, PP q (x, b) ~ c) => P (EitherX p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EitherX p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (EitherX p q r) -> POpts -> x -> m (TT (PP (EitherX p q r) x)) Source #

type PP (EitherX p q r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (EitherX p q r :: Type) x = EitherXT (PP r x) x p

type family EitherXT lr x p where ... Source #

Equations

EitherXT (Either a b) x p = PP p (x, a) 

data TheseX p q r s Source #

similar to mergeTheseWith but additionally provides 'p', '\q' and 'r' the original input as the first element in the tuple

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(TheseX (((Fst >> Fst) + Snd) >> ShowP) ShowP (Snd >> Snd) Snd) (9,This 123)
Present "132"
PresentT "132"
>>> pl @(TheseX '(Snd,"fromthis") '(99 >> Negate,Snd) Snd Id) (This 123)
Present (123,"fromthis")
PresentT (123,"fromthis")
>>> pl @(TheseX '(Snd,"fromthis") '(99 >> Negate,Snd) Snd Id) (That "fromthat")
Present (-99,"fromthat")
PresentT (-99,"fromthat")
>>> pl @(TheseX '(Snd,"fromthis") '(99 >> Negate,Snd) Snd Id) (These 123 "fromthese")
Present (123,"fromthese")
PresentT (123,"fromthese")
Instances
(P s x, P p (x, a), P q (x, b), P r (x, (a, b)), PP s x ~ These a b, PP p (x, a) ~ c, PP q (x, b) ~ c, PP r (x, (a, b)) ~ c) => P (TheseX p q r s :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TheseX p q r s) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (TheseX p q r s) -> POpts -> x -> m (TT (PP (TheseX p q r s) x)) Source #

type PP (TheseX p q r s :: Type) x Source # 
Instance details

Defined in Predicate

type PP (TheseX p q r s :: Type) x = TheseXT (PP s x) x p

type family TheseXT lr x p where ... Source #

Equations

TheseXT (These a b) x p = PP p (x, a) 

data MaybeIn p q Source #

similar to maybe

similar to MaybeX but provides a Proxy to the result of 'q' and does not provide the surrounding context

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MaybeIn "foundnothing" (Pred >> ShowP)) (Just 20)
Present "19"
PresentT "19"
>>> pl @(MaybeIn "found nothing" (Pred >> ShowP)) Nothing
Present "found nothing"
PresentT "found nothing"
Instances
(P q a, Show a, Show (PP q a), PP p (Proxy (PP q a)) ~ PP q a, P p (Proxy (PP q a))) => P (MaybeIn p q :: Type) (Maybe a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MaybeIn p q) (Maybe a) :: Type Source #

Methods

eval :: MonadEval m => Proxy (MaybeIn p q) -> POpts -> Maybe a -> m (TT (PP (MaybeIn p q) (Maybe a))) Source #

type PP (MaybeIn p q :: Type) (Maybe a) Source # 
Instance details

Defined in Predicate

type PP (MaybeIn p q :: Type) (Maybe a) = PP q a

data STimes n p Source #

similar to stimes

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(STimes 4 Id) (SG.Sum 3)
Present Sum {getSum = 12}
PresentT (Sum {getSum = 12})
>>> pl @(STimes 4 Id) "ab"
Present "abababab"
PresentT "abababab"
Instances
(P n a, Integral (PP n a), Semigroup (PP p a), P p a, Show (PP p a)) => P (STimes n p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (STimes n p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (STimes n p) -> POpts -> a -> m (TT (PP (STimes n p) a)) Source #

type PP (STimes n p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (STimes n p :: Type) a = PP p a

data Pure (t :: Type -> Type) p Source #

similar to pure

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Pure Maybe Id) 4
Present Just 4
PresentT (Just 4)
>>> pl @(Pure [] Id) 4
Present [4]
PresentT [4]
Instances
(P p x, Show (PP p x), Show (t (PP p x)), Applicative t) => P (Pure t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Pure t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Pure t p) -> POpts -> x -> m (TT (PP (Pure t p) x)) Source #

type PP (Pure t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Pure t p :: Type) x = t (PP p x)

data MemptyT' t Source #

similar to mempty

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MemptyT (SG.Sum Int)) ()
Present Sum {getSum = 0}
PresentT (Sum {getSum = 0})

no Monoid for Maybe a unless a is also a monoid but can use empty!

Instances
(Show (PP t a), Monoid (PP t a)) => P (MemptyT' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MemptyT' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MemptyT' t) -> POpts -> a -> m (TT (PP (MemptyT' t) a)) Source #

type PP (MemptyT' t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (MemptyT' t :: Type) a = PP t a

type MemptyT (t :: Type) = MemptyT' (Hole t) Source #

data MemptyProxy Source #

Instances
Monoid a => P MemptyProxy (Proxy a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP MemptyProxy (Proxy a) :: Type Source #

Methods

eval :: MonadEval m => Proxy MemptyProxy -> POpts -> Proxy a -> m (TT (PP MemptyProxy (Proxy a))) Source #

type PP MemptyProxy (Proxy a) Source # 
Instance details

Defined in Predicate

type PP MemptyProxy (Proxy a) = a

data EmptyT (t :: Type -> Type) Source #

similar to empty

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(EmptyT Maybe) ()
Present Nothing
PresentT Nothing
Instances
(Show (t a), Alternative t) => P (EmptyT t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EmptyT t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (EmptyT t) -> POpts -> a -> m (TT (PP (EmptyT t) a)) Source #

type PP (EmptyT t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (EmptyT t :: Type) a = t a

data MkNothing' t Source #

Instances
P (MkNothing' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkNothing' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkNothing' t) -> POpts -> a -> m (TT (PP (MkNothing' t) a)) Source #

type PP (MkNothing' t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (MkNothing' t :: Type) a = Maybe (PP t a)

type MkNothing (t :: Type) = MkNothing' (Hole t) Source #

data MkJust Source #

Just constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @MkJust 44
Present Just 44
PresentT (Just 44)
Instances
Show a => P MkJust a Source # 
Instance details

Defined in Predicate

Associated Types

type PP MkJust a :: Type Source #

Methods

eval :: MonadEval m => Proxy MkJust -> POpts -> a -> m (TT (PP MkJust a)) Source #

type PP MkJust a Source # 
Instance details

Defined in Predicate

type PP MkJust a = Maybe a

data MkLeft' t p Source #

Left constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MkLeft _ Id) 44
Present Left 44
PresentT (Left 44)
Instances
(Show (PP p x), P p x) => P (MkLeft' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkLeft' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkLeft' t p) -> POpts -> x -> m (TT (PP (MkLeft' t p) x)) Source #

type PP (MkLeft' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MkLeft' t p :: Type) x = Either (PP p x) (PP t x)

type MkLeft (t :: Type) p = MkLeft' (Hole t) p Source #

data MkRight' t p Source #

Right constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MkRight _ Id) 44
Present Right 44
PresentT (Right 44)
Instances
(Show (PP p x), P p x) => P (MkRight' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkRight' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkRight' t p) -> POpts -> x -> m (TT (PP (MkRight' t p) x)) Source #

type PP (MkRight' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MkRight' t p :: Type) x = Either (PP t x) (PP p x)

type MkRight (t :: Type) p = MkRight' (Hole t) p Source #

data MkThis' t p Source #

This constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MkThis _ Id) 44
Present This 44
PresentT (This 44)
Instances
(Show (PP p x), P p x) => P (MkThis' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThis' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThis' t p) -> POpts -> x -> m (TT (PP (MkThis' t p) x)) Source #

type PP (MkThis' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MkThis' t p :: Type) x = These (PP p x) (PP t x)

type MkThis (t :: Type) p = MkThis' (Hole t) p Source #

data MkThat' t p Source #

That constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MkThat _ Id) 44
Present That 44
PresentT (That 44)
Instances
(Show (PP p x), P p x) => P (MkThat' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThat' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThat' t p) -> POpts -> x -> m (TT (PP (MkThat' t p) x)) Source #

type PP (MkThat' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (MkThat' t p :: Type) x = These (PP t x) (PP p x)

type MkThat (t :: Type) p = MkThat' (Hole t) p Source #

data MkThese p q Source #

These constructor

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(MkThese Fst Snd) (44,'x')
Present These 44 'x'
PresentT (These 44 'x')
Instances
(P p a, P q a, Show (PP p a), Show (PP q a)) => P (MkThese p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (MkThese p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (MkThese p q) -> POpts -> a -> m (TT (PP (MkThese p q) a)) Source #

type PP (MkThese p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (MkThese p q :: Type) a = These (PP p a) (PP q a)

data MConcat Source #

similar to mconcat

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @MConcat [SG.Sum 44, SG.Sum 12, SG.Sum 3]
Present Sum {getSum = 59}
PresentT (Sum {getSum = 59})
Instances
(Show a, Monoid a) => P MConcat [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP MConcat [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy MConcat -> POpts -> [a] -> m (TT (PP MConcat [a])) Source #

type PP MConcat [a] Source # 
Instance details

Defined in Predicate

type PP MConcat [a] = a

type FoldMap (t :: Type) p = Map (Wrap t Id) p >> (MConcat >> Unwrap) Source #

type Sum (t :: Type) = FoldMap (Sum t) Id Source #

type Min' (t :: Type) = FoldMap (Min t) Id Source #

data Concat p Source #

similar to concat

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Concat Id) ["abc","D","eF","","G"]
Present "abcDeFG"
PresentT "abcDeFG"
>>> pl @(Concat Snd) ('x',["abc","D","eF","","G"])
Present "abcDeFG"
PresentT "abcDeFG"
Instances
(Show a, Show (t [a]), PP p x ~ t [a], P p x, Foldable t) => P (Concat p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Concat p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Concat p) -> POpts -> x -> m (TT (PP (Concat p) x)) Source #

type PP (Concat p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Concat p :: Type) x = (MapTX (PP p x) :: Type)

data ProxyT' t Source #

Instances
Typeable t => P (ProxyT' t :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ProxyT' t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ProxyT' t) -> POpts -> a -> m (TT (PP (ProxyT' t) a)) Source #

type PP (ProxyT' t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ProxyT' t :: Type) a = Proxy (PP t a)

type ProxyT (t :: Type) = ProxyT' (Hole t) Source #

data Ix (n :: Nat) def Source #

similar to !!

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Ix 4 "not found") ["abc","D","eF","","G"]
Present "G"
PresentT "G"
>>> pl @(Ix 40 "not found") ["abc","D","eF","","G"]
Present "not found"
PresentT "not found"
Instances
(P def (Proxy a), PP def (Proxy a) ~ a, KnownNat n, Show a) => P (Ix n def :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Ix n def) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (Ix n def) -> POpts -> [a] -> m (TT (PP (Ix n def) [a])) Source #

type PP (Ix n def :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (Ix n def :: Type) [a] = a

type Ix' (n :: Nat) = Ix n (Failp "Ix index not found") Source #

data IxL p q def Source #

similar to !! leveraging Ixed

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> import qualified Data.Map.Strict as M
>>> pl @(Id !! 2) ["abc","D","eF","","G"]
Present "eF"
PresentT "eF"
>>> pl @(Id !! 20) ["abc","D","eF","","G"]
Error (!!) index not found
FailT "(!!) index not found"
>>> pl @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
Present 2
PresentT 2
Instances
(P q a, P p a, Show (PP p a), Ixed (PP p a), PP q a ~ Index (PP p a), Show (Index (PP p a)), Show (IxValue (PP p a)), P r (Proxy (IxValue (PP p a))), PP r (Proxy (IxValue (PP p a))) ~ IxValue (PP p a)) => P (IxL p q r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IxL p q r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IxL p q r) -> POpts -> a -> m (TT (PP (IxL p q r) a)) Source #

type PP (IxL p q r :: Type) a Source # 
Instance details

Defined in Predicate

type PP (IxL p q r :: Type) a = IxValue (PP p a)

type (!!) p q = IxL p q (Failp "(!!) index not found") Source #

data Lookup p q Source #

lookup leveraging Ixed

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> import qualified Data.Map.Strict as M
>>> pl @(Id !!! 2) ["abc","D","eF","","G"]
Present "eF"
PresentT "eF"
>>> pl @(Id !!! 20) ["abc","D","eF","","G"]
Error index not found
FailT "index not found"
>>> pl @(Id !!! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
Present 2
PresentT 2
>>> pl @(Lookup Id 2) ["abc","D","eF","","G"]
Present Just "eF"
PresentT (Just "eF")
>>> pl @(Lookup Id 20) ["abc","D","eF","","G"]
Present Nothing
PresentT Nothing
Instances
(P q a, P p a, Show (PP p a), Ixed (PP p a), PP q a ~ Index (PP p a), Show (Index (PP p a)), Show (IxValue (PP p a))) => P (Lookup p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Lookup p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Lookup p q) -> POpts -> a -> m (TT (PP (Lookup p q) a)) Source #

type PP (Lookup p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Lookup p q :: Type) a = Maybe (IxValue (PP p a))

type (!!!) p q = Lookup p q >> MaybeIn (Failp "index not found") Id Source #

type Lookup' (t :: Type) p q = (q &&& Lookup p q) >> If (Snd >> IsNothing) (Fst >> (ShowP >> Fail (Hole t) (Printf "index(%s) not found" Id))) (Snd >> Just Id) Source #

data Ands Source #

ands

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Ands [True,True,True]
True
TrueT
>>> pl @Ands [True,True,True,False]
False
FalseT
>>> pl @Ands []
True
TrueT
Instances
(as ~ t a, Show (t a), Foldable t, a ~ Bool) => P Ands as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ands as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ands -> POpts -> as -> m (TT (PP Ands as)) Source #

type PP Ands as Source # 
Instance details

Defined in Predicate

type PP Ands as = Bool

data Ors Source #

ors

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Ors [False,False,False]
False
FalseT
>>> pl @Ors [True,True,True,False]
True
TrueT
>>> pl @Ors []
False
FalseT
Instances
(as ~ t a, Show (t a), Foldable t, a ~ Bool) => P Ors as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Ors as :: Type Source #

Methods

eval :: MonadEval m => Proxy Ors -> POpts -> as -> m (TT (PP Ors as)) Source #

type PP Ors as Source # 
Instance details

Defined in Predicate

type PP Ors as = Bool

data p :+ q infixr 5 Source #

similar to cons

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst :+ Snd) (99,[1,2,3,4])
Present [99,1,2,3,4]
PresentT [99,1,2,3,4]
Instances
(P p x, P q x, Show (PP p x), Show (PP q x), Cons (PP q x) (PP q x) (PP p x) (PP p x)) => P (p :+ q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p :+ q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p :+ q) -> POpts -> x -> m (TT (PP (p :+ q) x)) Source #

type PP (p :+ q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (p :+ q :: Type) x = PP q x

data p +: q infixl 5 Source #

similar to snoc

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Snd +: Fst) (99,[1,2,3,4])
Present [1,2,3,4,99]
PresentT [1,2,3,4,99]
Instances
(P p x, P q x, Show (PP q x), Show (PP p x), Snoc (PP p x) (PP p x) (PP q x) (PP q x)) => P (p +: q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p +: q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p +: q) -> POpts -> x -> m (TT (PP (p +: q) x)) Source #

type PP (p +: q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (p +: q :: Type) x = PP p x

data Uncons Source #

uncons

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Uncons [1,2,3,4]
Present Just (1,[2,3,4])
PresentT (Just (1,[2,3,4]))
>>> pl @Uncons []
Present Nothing
PresentT Nothing
Instances
(Show (ConsT s), Show s, Cons s s (ConsT s) (ConsT s)) => P Uncons s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Uncons s :: Type Source #

Methods

eval :: MonadEval m => Proxy Uncons -> POpts -> s -> m (TT (PP Uncons s)) Source #

type PP Uncons s Source # 
Instance details

Defined in Predicate

type PP Uncons s = Maybe (ConsT s, s)

data Unsnoc Source #

unsnoc

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Unsnoc [1,2,3,4]
Present Just ([1,2,3],4)
PresentT (Just ([1,2,3],4))
>>> pl @Unsnoc []
Present Nothing
PresentT Nothing
Instances
(Show (ConsT s), Show s, Snoc s s (ConsT s) (ConsT s)) => P Unsnoc s Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unsnoc s :: Type Source #

Methods

eval :: MonadEval m => Proxy Unsnoc -> POpts -> s -> m (TT (PP Unsnoc s)) Source #

type PP Unsnoc s Source # 
Instance details

Defined in Predicate

type PP Unsnoc s = Maybe (s, ConsT s)

data IsEmpty Source #

similar to null using AsEmpty

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @IsEmpty [1,2,3,4]
False
FalseT
>>> pl @IsEmpty []
True
TrueT
>>> pl @IsEmpty LT
False
FalseT
>>> pl @IsEmpty EQ
True
TrueT
Instances
(Show as, AsEmpty as) => P IsEmpty as Source # 
Instance details

Defined in Predicate

Associated Types

type PP IsEmpty as :: Type Source #

Methods

eval :: MonadEval m => Proxy IsEmpty -> POpts -> as -> m (TT (PP IsEmpty as)) Source #

type PP IsEmpty as Source # 
Instance details

Defined in Predicate

type PP IsEmpty as = Bool

data Null Source #

similar to null using Foldable

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Null [1,2,3,4]
False
FalseT
>>> pl @Null []
True
TrueT
Instances
(Show (t a), Foldable t, t a ~ as) => P Null as Source # 
Instance details

Defined in Predicate

Associated Types

type PP Null as :: Type Source #

Methods

eval :: MonadEval m => Proxy Null -> POpts -> as -> m (TT (PP Null as)) Source #

type PP Null as Source # 
Instance details

Defined in Predicate

type PP Null as = Bool

data EnumFromTo p q Source #

similar to enumFromTo

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(EnumFromTo 2 5) ()
Present [2,3,4,5]
PresentT [2,3,4,5]
>>> pl @(EnumFromTo LT GT) ()
Present [LT,EQ,GT]
PresentT [LT,EQ,GT]
Instances
(P p x, P q x, PP p x ~ a, Show a, PP q x ~ a, Enum a) => P (EnumFromTo p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (EnumFromTo p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (EnumFromTo p q) -> POpts -> x -> m (TT (PP (EnumFromTo p q) x)) Source #

type PP (EnumFromTo p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (EnumFromTo p q :: Type) x = [PP p x]

data PartitionEithers Source #

similar to partitionEithers

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
Present ("ac",[2,4,99])
PresentT ("ac",[2,4,99])
Instances
(Show a, Show b) => P PartitionEithers [Either a b] Source # 
Instance details

Defined in Predicate

Associated Types

type PP PartitionEithers [Either a b] :: Type Source #

Methods

eval :: MonadEval m => Proxy PartitionEithers -> POpts -> [Either a b] -> m (TT (PP PartitionEithers [Either a b])) Source #

type PP PartitionEithers [Either a b] Source # 
Instance details

Defined in Predicate

type PP PartitionEithers [Either a b] = ([a], [b])

data PartitionThese Source #

similar to partitionThese

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @PartitionThese [This 'a', That 2, This 'c', These 'z' 1, That 4, These 'a' 2, That 99]
Present (("ac",[2,4,99]),[('z',1),('a',2)])
PresentT (("ac",[2,4,99]),[('z',1),('a',2)])
Instances
(Show a, Show b) => P PartitionThese [These a b] Source # 
Instance details

Defined in Predicate

Associated Types

type PP PartitionThese [These a b] :: Type Source #

Methods

eval :: MonadEval m => Proxy PartitionThese -> POpts -> [These a b] -> m (TT (PP PartitionThese [These a b])) Source #

type PP PartitionThese [These a b] Source # 
Instance details

Defined in Predicate

type PP PartitionThese [These a b] = (([a], [b]), [(a, b)])

data Scanl p q r Source #

similar to scanl

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Scanl (Snd :+ Fst) Fst Snd) ([99],[1..5])
Present [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
PresentT [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
Instances
(PP p (b, a) ~ b, PP q x ~ b, PP r x ~ [a], P p (b, a), P q x, P r x, Show b, Show a) => P (Scanl p q r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Scanl p q r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Scanl p q r) -> POpts -> x -> m (TT (PP (Scanl p q r) x)) Source #

type PP (Scanl p q r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Scanl p q r :: Type) x = [PP q x]

type ScanN n p q = Scanl (Fst >> q) p (EnumFromTo 1 n) Source #

type ScanNA q = ScanN Fst Snd q Source #

type Repeat n p q = Last' (ScanN n p q) Source #

type Foldl p q r = Last' (Scanl p q r) Source #

type family UnfoldT mbs where ... Source #

Equations

UnfoldT (Maybe (b, s)) = b 

data Unfoldr p q Source #

similar to unfoldr

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Unfoldr (MaybeB (Null >> Not) (SplitAt 2 Id)) Id) [1..5]
Present [[1,2],[3,4],[5]]
PresentT [[1,2],[3,4],[5]]
Instances
(PP q a ~ s, PP p s ~ Maybe (b, s), P q a, P p s, Show s, Show b) => P (Unfoldr p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Unfoldr p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Unfoldr p q) -> POpts -> a -> m (TT (PP (Unfoldr p q) a)) Source #

type PP (Unfoldr p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Unfoldr p q :: Type) a = [UnfoldT (PP p (PP q a))]

type IterateN n f = Unfoldr (MaybeB (Fst > 0) '(Snd, Pred *** f)) '(n, Id) Source #

type IterateWhile p f = Unfoldr (MaybeB p '(Id, f)) Id Source #

type IterateNWhile n p f = '(n, Id) >> (IterateWhile ((Fst > 0) && (Snd >> p)) (Pred *** f) >> Map Snd Id) Source #

type IterateNUntil n p f = IterateNWhile n (p >> Not) f Source #

data Map p q Source #

similar to map

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Map Pred Id) [1..5]
Present [0,1,2,3,4]
PresentT [0,1,2,3,4]
Instances
(Show (PP p a), P p a, PP q x ~ f a, P q x, Show a, Show (f a), Foldable f) => P (Map p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Map p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Map p q) -> POpts -> x -> m (TT (PP (Map p q) x)) Source #

type PP (Map p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Map p q :: Type) x = [PP p (MapTX (PP q x) :: Type)]

type ConcatMap p q = Concat (Map p q) Source #

type family MapTX ta where ... Source #

Equations

MapTX (t a) = a 

data If p q r Source #

if p then run q else run r

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(If (Gt 4) "greater than 4" "less than or equal to 4" ) 10
Present "greater than 4"
PresentT "greater than 4"
>>> pl @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
Present "less than or equal to 4"
PresentT "less than or equal to 4"
Instances
(Show (PP r a), P p a, PP p a ~ Bool, P q a, P r a, PP q a ~ PP r a) => P (If p q r :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (If p q r) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (If p q r) -> POpts -> a -> m (TT (PP (If p q r) a)) Source #

type PP (If p q r :: Type) a Source # 
Instance details

Defined in Predicate

type PP (If p q r :: Type) a = PP q a

data Pairs Source #

creates a list of overlapping pairs of elements

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Pairs [1,2,3,4]
Present [(1,2),(2,3),(3,4)]
PresentT [(1,2),(2,3),(3,4)]
>>> pl @Pairs []
Error Pairs no data found
FailT "Pairs no data found"
>>> pl @Pairs [1]
Error Pairs only one element found
FailT "Pairs only one element found"
Instances
Show a => P Pairs [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP Pairs [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy Pairs -> POpts -> [a] -> m (TT (PP Pairs [a])) Source #

type PP Pairs [a] Source # 
Instance details

Defined in Predicate

type PP Pairs [a] = [(a, a)]

data Partition p q Source #

similar to partition

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Partition (Ge 3) Id) [10,4,1,7,3,1,3,5]
Present ([10,4,7,3,3,5],[1,1])
PresentT ([10,4,7,3,3,5],[1,1])
Instances
(P p x, Show x, PP q a ~ [x], PP p x ~ Bool, P q a) => P (Partition p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Partition p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Partition p q) -> POpts -> a -> m (TT (PP (Partition p q) a)) Source #

type PP (Partition p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Partition p q :: Type) a = (PP q a, PP q a)

type FilterBy p q = Partition p q >> Fst Source #

data Break p q Source #

similar to break

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Break (Ge 3) Id) [10,4,1,7,3,1,3,5]
Present ([],[10,4,1,7,3,1,3,5])
PresentT ([],[10,4,1,7,3,1,3,5])
>>> pl @(Break (Lt 3) Id) [10,4,1,7,3,1,3,5]
Present ([10,4],[1,7,3,1,3,5])
PresentT ([10,4],[1,7,3,1,3,5])
Instances
(P p x, PP q a ~ [x], PP p x ~ Bool, P q a) => P (Break p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Break p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Break p q) -> POpts -> a -> m (TT (PP (Break p q) a)) Source #

type PP (Break p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Break p q :: Type) a = (PP q a, PP q a)

type Span p q = Break (p >> Not) q Source #

data Fail t prt Source #

Fails the computation with a message

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Failt Int (Printf "value=%03d" Id)) 99
Error value=099
FailT "value=099"
>>> pl @(FailS (Printf2 "value=%03d string=%s")) (99,"somedata")
Error value=099 string=somedata
FailT "value=099 string=somedata"
Instances
(P prt a, PP prt a ~ String) => P (Fail t prt :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Fail t prt) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Fail t prt) -> POpts -> a -> m (TT (PP (Fail t prt) a)) Source #

type PP (Fail t prt :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Fail t prt :: Type) a = PP t a

type Failt (t :: Type) prt = Fail (Hole t) prt Source #

type FailS s = Fail I s Source #

type FailPrt (t :: Type) prt = Fail (Hole t) (Printf prt) Source #

type FailPrt2 (t :: Type) prt = Fail (Hole t) (Printf2 prt) Source #

data Hole (t :: Type) Source #

Instances
Typeable t => P (Hole t :: Type) a Source #

Acts as a proxy in this dsl where you can explicitly set the Type.

It is passed around as an argument to help the type checker when needed. see ReadP, ParseTimeP, ShowP

Instance details

Defined in Predicate

Associated Types

type PP (Hole t) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Hole t) -> POpts -> a -> m (TT (PP (Hole t) a)) Source #

type PP (Hole t :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Hole t :: Type) a = t

type T (t :: Type) = Hole t Source #

data Unproxy Source #

Instances
Typeable a => P Unproxy (Proxy a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Unproxy (Proxy a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Unproxy -> POpts -> Proxy a -> m (TT (PP Unproxy (Proxy a))) Source #

type PP Unproxy (Proxy a) Source # 
Instance details

Defined in Predicate

type PP Unproxy (Proxy a) = a

data W (p :: k) Source #

transparent predicate wrapper to make k of kind Type so it can be in a promoted list (cant mix kinds) see Do

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Do '[W 123, W "xyz", Len &&& Id, Pred *** Id<>Id]) ()
Present (2,"xyzxyz")
PresentT (2,"xyzxyz")
>>> pl @(TupleI '[W 999,W "somestring",W 'True, Id, Pred >> ShowP]) 23
Present (999,("somestring",(True,(23,("22",())))))
PresentT (999,("somestring",(True,(23,("22",())))))
Instances
P p a => P (W p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (W p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (W p) -> POpts -> a -> m (TT (PP (W p) a)) Source #

type PP (W p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (W p :: Type) a = PP p a

data Catch p q Source #

catch a failure

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Catch Succ (Fst >> Second ShowP >> Printf2 "%s %s" >> 'LT)) GT
Present LT
PresentT LT
>>> pl @(Catch' Succ (Second ShowP >> Printf2 "%s %s")) GT
Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT
FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"
>>> pl @(Catch' Succ (Second ShowP >> Printf2 "%s %s")) LT
Present EQ
PresentT EQ

more flexible: takes a (String,x) and a proxy so we can still call 'False 'True now takes the FailT string and x so you can print more detail if you want need the proxy so we can fail without having to explicitly specify a type

Instances
(P p x, P q ((String, x), Proxy (PP p x)), PP p x ~ PP q ((String, x), Proxy (PP p x))) => P (Catch p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Catch p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Catch p q) -> POpts -> x -> m (TT (PP (Catch p q) x)) Source #

type PP (Catch p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Catch p q :: Type) x = PP p x

type Catch' p s = Catch p (FailCatch s) Source #

type Even = Mod I 2 >> Same 0 Source #

type Odd = Mod I 2 >> Same 1 Source #

type Div' p q = DivMod p q >> Fst Source #

type Mod' p q = DivMod p q >> Snd Source #

data Div p q Source #

similar to div

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Div Fst Snd) (10,4)
Present 2
PresentT 2
>>> pl @(Div Fst Snd) (10,0)
Error Div zero denominator
FailT "Div zero denominator"
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (Div p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Div p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Div p q) -> POpts -> a -> m (TT (PP (Div p q) a)) Source #

type PP (Div p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Div p q :: Type) a = PP p a

data Mod p q Source #

similar to mod

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Mod Fst Snd) (10,3)
Present 1
PresentT 1
>>> pl @(Mod Fst Snd) (10,0)
Error Mod zero denominator
FailT "Mod zero denominator"
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (Mod p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Mod p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Mod p q) -> POpts -> a -> m (TT (PP (Mod p q) a)) Source #

type PP (Mod p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Mod p q :: Type) a = PP p a

data DivMod p q Source #

similar to divMod

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(DivMod Fst Snd) (10,3)
Present (3,1)
PresentT (3,1)
>>> pl @(DivMod Fst Snd) (10,-3)
Present (-4,-2)
PresentT (-4,-2)
>>> pl @(DivMod Fst Snd) (-10,3)
Present (-4,2)
PresentT (-4,2)
>>> pl @(DivMod Fst Snd) (-10,-3)
Present (3,-1)
PresentT (3,-1)
>>> pl @(DivMod Fst Snd) (10,0)
Error DivMod zero denominator
FailT "DivMod zero denominator"
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (DivMod p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (DivMod p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (DivMod p q) -> POpts -> a -> m (TT (PP (DivMod p q) a)) Source #

type PP (DivMod p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (DivMod p q :: Type) a = (PP p a, PP p a)

data QuotRem p q Source #

similar to quotRem

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(QuotRem Fst Snd) (10,3)
Present (3,1)
PresentT (3,1)
>>> pl @(QuotRem Fst Snd) (10,-3)
Present (-3,1)
PresentT (-3,1)
>>> pl @(QuotRem Fst Snd) (-10,-3)
Present (3,-1)
PresentT (3,-1)
>>> pl @(QuotRem Fst Snd) (-10,3)
Present (-3,-1)
PresentT (-3,-1)
>>> pl @(QuotRem Fst Snd) (10,0)
Error QuotRem zero denominator
FailT "QuotRem zero denominator"
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Integral (PP p a)) => P (QuotRem p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (QuotRem p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (QuotRem p q) -> POpts -> a -> m (TT (PP (QuotRem p q) a)) Source #

type PP (QuotRem p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (QuotRem p q :: Type) a = (PP p a, PP p a)

type Quot p q = QuotRem p q >> Fst Source #

type Rem p q = QuotRem p q >> Snd Source #

type OneP = Guard (Printf "expected list of length 1 but found length=%d" Len) (Len >> Same 1) >> Head Source #

strictmsg :: forall strict. GetBool strict => String Source #

data GuardsImpl (n :: Nat) (strict :: Bool) (os :: [(k, k1)]) Source #

Guards contain a type level list of tuples the action to run on failure of the predicate and the predicate itself Each tuple validating against the corresponding value in a value list

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 4)]) [17,4]
Present [17,4]
PresentT [17,4]
>>> pl @(Guards '[ '("arg1 failed",Gt 4), '("arg2 failed", Same 5)]) [17,4]
Error arg2 failed
FailT "arg2 failed"
>>> pl @(Guards '[ '("arg1 failed",Gt 99), '("arg2 failed", Same 4)]) [17,4]
Error arg1 failed
FailT "arg1 failed"
>>> pl @(Guards '[ '(Printf2 "arg %d failed with value %d",Gt 4), '(Printf2 "%d %d", Same 4)]) [17,3]
Error 1 3
FailT "1 3"
>>> pl @(GuardsQuick (Printf2 "arg %d failed with value %d") '[Gt 4, Ge 3, Same 4]) [17,3,5]
Error arg 2 failed with value 5
FailT "arg 2 failed with value 5"
>>> pl @(GuardsQuick (Printf2 "arg %d failed with value %d") '[Gt 4, Ge 3, Same 4]) [17,3,5,99]
Error Guards: data elements(4) /= predicates(3)
FailT "Guards: data elements(4) /= predicates(3)"
Instances
(KnownNat n, GetBool strict, Show a) => P (GuardsImpl n strict ([] :: [(k, k1)]) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImpl n strict []) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImpl n strict []) -> POpts -> [a] -> m (TT (PP (GuardsImpl n strict []) [a])) Source #

(PP prt (Int, a) ~ String, P prt (Int, a), KnownNat n, GetBool strict, GetLen ps, P p a, PP p a ~ Bool, P (GuardsImpl n strict ps) [a], PP (GuardsImpl n strict ps) [a] ~ [a], Show a) => P (GuardsImpl n strict ((,) prt p ': ps) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImpl n strict ((prt, p) ': ps)) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImpl n strict ((prt, p) ': ps)) -> POpts -> [a] -> m (TT (PP (GuardsImpl n strict ((prt, p) ': ps)) [a])) Source #

type PP (GuardsImpl n strict ((,) prt p ': ps) :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (GuardsImpl n strict ((,) prt p ': ps) :: Type) [a] = [a]
type PP (GuardsImpl n strict ([] :: [(k, k1)]) :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (GuardsImpl n strict ([] :: [(k, k1)]) :: Type) [a] = [a]

type Guards (os :: [(k, k1)]) = GuardsImplW True os Source #

type GuardsLax (os :: [(k, k1)]) = GuardsImplW False os Source #

type GuardsQuick (prt :: k) (os :: [k1]) = Guards (ToGuardsT prt os) Source #

data GuardsImplW (strict :: Bool) (ps :: [(k, k1)]) Source #

Instances
(GetBool strict, GetLen ps, P (GuardsImpl (LenT ps) strict ps) [a]) => P (GuardsImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (GuardsImplW strict ps) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsImplW strict ps) -> POpts -> [a] -> m (TT (PP (GuardsImplW strict ps) [a])) Source #

type PP (GuardsImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (GuardsImplW strict ps :: Type) [a] = PP (GuardsImpl (LenT ps) strict ps) [a]

data Guard prt p Source #

'p' is the predicate and on failure of the predicate runs 'prt'

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Guard "expected > 3" (Gt 3)) 17
Present 17
PresentT 17
>>> pl @(Guard "expected > 3" (Gt 3)) 1
Error expected > 3
FailT "expected > 3"
>>> pl @(Guard (Printf "%d not > 3" Id) (Gt 3)) (-99)
Error -99 not > 3
FailT "-99 not > 3"
Instances
(Show a, P prt a, PP prt a ~ String, P p a, PP p a ~ Bool) => P (Guard prt p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Guard prt p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Guard prt p) -> POpts -> a -> m (TT (PP (Guard prt p) a)) Source #

type PP (Guard prt p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Guard prt p :: Type) a = a

type Guard' p = Guard "Guard" p Source #

type ExitWhen prt p = Guard prt (p >> Not) Source #

type ExitWhen' p = ExitWhen "ExitWhen" p Source #

data Skip p Source #

Instances
(Show (PP p a), P p a) => P (Skip p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Skip p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Skip p) -> POpts -> a -> m (TT (PP (Skip p) a)) Source #

type PP (Skip p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Skip p :: Type) a = a

type (|>) p q = Skip p >> q infixr 1 Source #

type (>|) p q = p >> Skip q infixr 1 Source #

data (p :: k) >> (q :: k1) infixr 1 Source #

This is composition for predicates

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst >> Id !! 0 >> Succ) ([11,12],'x')
Present 12
PresentT 12
>>> pl @(Len *** Succ >> First Pred >> ShowP) ([11,12],'x')
Present "(1,'y')"
PresentT "(1,'y')"
Instances
(Show (PP p a), Show (PP q (PP p a)), P p a, P q (PP p a)) => P (p >> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p >> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p >> q) -> POpts -> a -> m (TT (PP (p >> q) a)) Source #

type PP (p >> q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p >> q :: Type) a = PP q (PP p a)

type (<<) p q = q >> p infixl 1 Source #

data (p :: k) && (q :: k1) infixr 3 Source #

similar to &&

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst && (Snd >> Len >> Ge 4)) (True,[11,12,13,14])
True
TrueT
>>> pl @(Fst && (Snd >> Len >> Same 4)) (True,[12,11,12,13,14])
False
FalseT
Instances
(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p && q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p && q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p && q) -> POpts -> a -> m (TT (PP (p && q) a)) Source #

type PP (p && q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p && q :: Type) a = Bool

type And p q = p && q Source #

data (p :: k) || (q :: k1) infixr 2 Source #

similar to ||

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst || (Snd >> Len >> Ge 4)) (False,[11,12,13,14])
True
TrueT
>>> pl @((Fst >> Not) || (Snd >> Len >> Same 4)) (True,[12,11,12,13,14])
False
FalseT
Instances
(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p || q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p || q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p || q) -> POpts -> a -> m (TT (PP (p || q) a)) Source #

type PP (p || q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p || q :: Type) a = Bool

type OR p q = p || q Source #

data (p :: k) ~> (q :: k1) infixr 1 Source #

implication

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst ~> (Snd >> Len >> Ge 4)) (True,[11,12,13,14])
True
TrueT
>>> pl @(Fst ~> (Snd >> Len >> Same 4)) (True,[12,11,12,13,14])
False
FalseT
>>> pl @(Fst ~> (Snd >> Len >> Same 4)) (False,[12,11,12,13,14])
True
TrueT
>>> pl @(Fst ~> (Snd >> Len >> Ge 4)) (False,[11,12,13,14])
True
TrueT
Instances
(P p a, P q a, PP p a ~ Bool, PP q a ~ Bool) => P (p ~> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p ~> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p ~> q) -> POpts -> a -> m (TT (PP (p ~> q) a)) Source #

type PP (p ~> q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p ~> q :: Type) a = Bool

type Imply p q = p ~> q Source #

data OrdP p q Source #

Instances
(Ord (PP p a), PP p a ~ PP q a, P p a, Show (PP q a), P q a) => P (OrdP p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (OrdP p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (OrdP p q) -> POpts -> a -> m (TT (PP (OrdP p q) a)) Source #

type PP (OrdP p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (OrdP p q :: Type) a = Ordering

type (===) p q = OrdP p q infix 4 Source #

type OrdA' p q = OrdP (Fst >> p) (Snd >> q) Source #

similar to compare

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(OrdP Fst Snd) (10,9)
Present GT
PresentT GT
>>> pl @(OrdP Fst Snd) (10,10)
Present EQ
PresentT EQ
>>> pl @(OrdP Fst Snd) (10,11)
Present LT
PresentT LT

type OrdA p = OrdA' p p Source #

data OrdI p q Source #

compare two strings ignoring case

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst ===? Snd) ("abC","aBc")
Present EQ
PresentT EQ
>>> pl @(Fst ===? Snd) ("abC","DaBc")
Present LT
PresentT LT
Instances
(PP p a ~ String, PP p a ~ PP q a, P p a, P q a) => P (OrdI p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (OrdI p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (OrdI p q) -> POpts -> a -> m (TT (PP (OrdI p q) a)) Source #

type PP (OrdI p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (OrdI p q :: Type) a = Ordering

type (===?) p q = OrdI p q infix 4 Source #

data Cmp (o :: OrderingP) p q Source #

Instances
(GetOrd o, Ord (PP p a), Show (PP p a), PP p a ~ PP q a, P p a, P q a) => P (Cmp o p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Cmp o p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Cmp o p q) -> POpts -> a -> m (TT (PP (Cmp o p q) a)) Source #

type PP (Cmp o p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Cmp o p q :: Type) a = Bool

data CmpI (o :: OrderingP) p q Source #

Instances
(PP p a ~ String, GetOrd o, PP p a ~ PP q a, P p a, P q a) => P (CmpI o p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CmpI o p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (CmpI o p q) -> POpts -> a -> m (TT (PP (CmpI o p q) a)) Source #

type PP (CmpI o p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (CmpI o p q :: Type) a = Bool

type Gt n = Cmp Cgt I n Source #

type Ge n = Cmp Cge I n Source #

type Same n = Cmp Ceq I n Source #

type Le n = Cmp Cle I n Source #

type Lt n = Cmp Clt I n Source #

type Ne n = Cmp Cne I n Source #

data IToList' t p Source #

similar to itoList

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(IToList _) ("aBc" :: String)
Present [(0,'a'),(1,'B'),(2,'c')]
PresentT [(0,'a'),(1,'B'),(2,'c')]
Instances
(Show x, P p x, Typeable (PP t (PP p x)), Show (PP t (PP p x)), FoldableWithIndex (PP t (PP p x)) f, PP p x ~ f a, Show a) => P (IToList' t p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IToList' t p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (IToList' t p) -> POpts -> x -> m (TT (PP (IToList' t p) x)) Source #

type PP (IToList' t p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (IToList' t p :: Type) x = [(PP t (PP p x), (UnIToListT (PP p x) :: Type))]

type IToList (t :: Type) = IToList' (Hole t) Id Source #

type family UnIToListT fa where ... Source #

Equations

UnIToListT (f a) = a 

data ToList Source #

similar to toList

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @ToList "aBc"
Present "aBc"
PresentT "aBc"
Instances
(Show (t a), Foldable t, Show a) => P ToList (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToList (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy ToList -> POpts -> t a -> m (TT (PP ToList (t a))) Source #

type PP ToList (t a) Source # 
Instance details

Defined in Predicate

type PP ToList (t a) = [a]

data ToListExt Source #

Instances
(Show l, IsList l, Show (Item l)) => P ToListExt l Source # 
Instance details

Defined in Predicate

Associated Types

type PP ToListExt l :: Type Source #

Methods

eval :: MonadEval m => Proxy ToListExt -> POpts -> l -> m (TT (PP ToListExt l)) Source #

type PP ToListExt l Source # 
Instance details

Defined in Predicate

type PP ToListExt l = [Item l]

data FromList (t :: Type) Source #

Instances
(a ~ Item t, Show t, IsList t) => P (FromList t :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromList t) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromList t) -> POpts -> [a] -> m (TT (PP (FromList t) [a])) Source #

type PP (FromList t :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (FromList t :: Type) [a] = t

data FromListF (t :: Type) Source #

Instances
(Show l, IsList l, l ~ l') => P (FromListF l' :: Type) l Source # 
Instance details

Defined in Predicate

Associated Types

type PP (FromListF l') l :: Type Source #

Methods

eval :: MonadEval m => Proxy (FromListF l') -> POpts -> l -> m (TT (PP (FromListF l') l)) Source #

type PP (FromListF l' :: Type) l Source # 
Instance details

Defined in Predicate

type PP (FromListF l' :: Type) l = l'

data IsTh (th :: These x y) Source #

predicate on These

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @IsThis (This "aBc")
True
TrueT
>>> pl @IsThis (These 1 'a')
False
FalseT
>>> pl @IsThese (These 1 'a')
True
TrueT
Instances
(Show a, Show b, GetThese th) => P (IsTh th :: Type) (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsTh th) (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsTh th) -> POpts -> These a b -> m (TT (PP (IsTh th) (These a b))) Source #

type PP (IsTh th :: Type) (These a b) Source # 
Instance details

Defined in Predicate

type PP (IsTh th :: Type) (These a b) = Bool

data TheseIn p q r Source #

similar to these

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(TheseIn Id Len (Fst + Length Snd)) (This 13)
Present 13
PresentT 13
>>> pl @(TheseIn Id Len (Fst + Length Snd)) (That "this is a long string")
Present 21
PresentT 21
>>> pl @(TheseIn Id Len (Fst + Length Snd)) (These 20 "somedata")
Present 28
PresentT 28
>>> pl @(TheseIn (Left _) (Right _) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (That "this is a long string")
Present Right "this is a long string"
PresentT (Right "this is a long string")
>>> pl @(TheseIn (Left _) (Right _) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 1 "this is a long string")
Present Right "this is a long string"
PresentT (Right "this is a long string")
>>> pl @(TheseIn (Left _) (Right _) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 100 "this is a long string")
Present Left 100
PresentT (Left 100)
Instances
(Show a, Show b, Show (PP p a), P p a, P q b, P r (a, b), PP p a ~ PP q b, PP p a ~ PP r (a, b), PP q b ~ PP r (a, b)) => P (TheseIn p q r :: Type) (These a b) Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TheseIn p q r) (These a b) :: Type Source #

Methods

eval :: MonadEval m => Proxy (TheseIn p q r) -> POpts -> These a b -> m (TT (PP (TheseIn p q r) (These a b))) Source #

type PP (TheseIn p q r :: Type) (These a b) Source # 
Instance details

Defined in Predicate

type PP (TheseIn p q r :: Type) (These a b) = PP p a

type Theseid p q = TheseIn '(I, p) '(q, I) I Source #

data Char1 (s :: Symbol) Source #

extracts the first character from a non empty Symbol

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Char1 "aBc") ()
Present 'a'
PresentT 'a'
Instances
(KnownSymbol s, NullT s ~ False) => P (Char1 s :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Char1 s) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Char1 s) -> POpts -> a -> m (TT (PP (Char1 s) a)) Source #

type PP (Char1 s :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Char1 s :: Type) a = Char

data ZipThese p q Source #

similar to align thats pads with This or That if one list is shorter than the other

the key is that all information about both lists are preserved

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ZipThese Fst Snd) ("aBc", [1..5])
Present [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
PresentT [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
>>> pl @(ZipThese Fst Snd) ("aBcDeF", [1..3])
Present [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
PresentT [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
Instances
(PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (ZipThese p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ZipThese p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ZipThese p q) -> POpts -> a -> m (TT (PP (ZipThese p q) a)) Source #

type PP (ZipThese p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ZipThese p q :: Type) a = [These (ArrT (PP p a)) (ArrT (PP q a))]

data ZipTheseF p q Source #

Instances
(Show (f y), PP p a ~ f x, PP q a ~ f y, ExtractT (f x) ~ x, ExtractT (f y) ~ y, Show (f x), Align f, Show (f (These x y)), P p a, P q a) => P (ZipTheseF p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ZipTheseF p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ZipTheseF p q) -> POpts -> a -> m (TT (PP (ZipTheseF p q) a)) Source #

type PP (ZipTheseF p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ZipTheseF p q :: Type) a = ApplyConstT (PP p a) (These (ExtractT (PP p a)) (ExtractT (PP q a)))

type family ExtractT (ta :: Type) :: Type where ... Source #

Equations

ExtractT (t a) = a 
ExtractT ta = TypeError (Text "ExtractT: expected (t a) but found something else" :$$: (Text "t a = " :<>: ShowType ta)) 

data Zip (lc :: Bool) (rc :: Bool) p q Source #

Zip two lists optionally cycling the one of the lists to match the size

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Ziplc Fst Snd) ("abc", [1..5])
Present [('a',1),('b',2),('c',3),('a',4),('b',5)]
PresentT [('a',1),('b',2),('c',3),('a',4),('b',5)]
>>> pl @(Ziplc Fst Snd) ("abcdefg", [1..5])
Present [('a',1),('b',2),('c',3),('d',4),('e',5)]
PresentT [('a',1),('b',2),('c',3),('d',4),('e',5)]
>>> pl @(Ziprc Fst Snd) ("abcdefg", [1..5])
Present [('a',1),('b',2),('c',3),('d',4),('e',5),('f',1),('g',2)]
PresentT [('a',1),('b',2),('c',3),('d',4),('e',5),('f',1),('g',2)]
Instances
(GetBool lc, GetBool rc, PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (Zip lc rc p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Zip lc rc p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Zip lc rc p q) -> POpts -> a -> m (TT (PP (Zip lc rc p q) a)) Source #

type PP (Zip lc rc p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Zip lc rc p q :: Type) a = [(ArrT (PP p a), ArrT (PP q a))]

type Ziplc p q = Zip True False p q Source #

type Ziprc p q = Zip False True p q Source #

type Zipn p q = Zip False False p q Source #

data Luhn Source #

Luhn predicate check on last digit

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Luhn [1,2,3,0]
True
TrueT
>>> pl @Luhn [1,2,3,4]
False
FalseT
Instances
a ~ [Int] => P Luhn a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Luhn a :: Type Source #

Methods

eval :: MonadEval m => Proxy Luhn -> POpts -> a -> m (TT (PP Luhn a)) Source #

type PP Luhn a Source # 
Instance details

Defined in Predicate

type PP Luhn a = Bool

pe0 :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pe :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pe1 :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pe2 :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pex :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pe3 :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

pl :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

plc :: forall p a. (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) Source #

peWith :: forall p a. (Show (PP p a), P p a) => POpts -> a -> IO (BoolT (PP p a)) Source #

data ReadBase' t (n :: Nat) p Source #

Read a number base 2 via 36

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ReadBase Int 16) "00feD"
Present 4077
PresentT 4077
>>> pl @(ReadBase Int 16) "-ff"
Present -255
PresentT (-255)
>>> pl @(ReadBase Int 2) "10010011"
Present 147
PresentT 147

supports negative numbers unlike readInt

Instances
(Typeable (PP t x), BetweenT 2 36 n, Show (PP t x), Num (PP t x), KnownNat n, PP p x ~ String, P p x) => P (ReadBase' t n p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadBase' t n p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadBase' t n p) -> POpts -> x -> m (TT (PP (ReadBase' t n p) x)) Source #

type PP (ReadBase' t n p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReadBase' t n p :: Type) x = PP t x

type ReadBase (t :: Type) (n :: Nat) = ReadBase' (Hole t) n Id Source #

data ShowBase (n :: Nat) Source #

Display a number at base 2 to 36

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ShowBase 16) 4077
Present "fed"
PresentT "fed"
>>> pl @(ShowBase 16) (-255)
Present "-ff"
PresentT "-ff"
>>> pl @(ShowBase 2) 147
Present "10010011"
PresentT "10010011"

supports negative numbers unlike showIntAtBase

Instances
(Show a, 2 <= n, n <= 36, KnownNat n, Integral a) => P (ShowBase n :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ShowBase n) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (ShowBase n) -> POpts -> a -> m (TT (PP (ShowBase n) a)) Source #

type PP (ShowBase n :: Type) a Source # 
Instance details

Defined in Predicate

type PP (ShowBase n :: Type) a = String

type Assocl = '(I *** Fst, Snd >> Snd) Source #

type Assocr = '(Fst >> Fst, Snd *** I) Source #

data Intercalate p q Source #

Intercalate

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()
Present ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
PresentT ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
Instances
(PP p a ~ [x], PP q a ~ PP p a, P p a, P q a, Show x) => P (Intercalate p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Intercalate p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Intercalate p q) -> POpts -> a -> m (TT (PP (Intercalate p q) a)) Source #

type PP (Intercalate p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Intercalate p q :: Type) a = PP p a

data Printf s p Source #

uses Printf to format output

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Printf "value=%03d" Id) 12
Present "value=012"
PresentT "value=012"

splits string into pieces before "%" that way we have a chance of catching any errors

Instances
(PrintfArg (PP p x), Show (PP p x), PP s x ~ String, P s x, P p x) => P (Printf s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Printf s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Printf s p) -> POpts -> x -> m (TT (PP (Printf s p) x)) Source #

type PP (Printf s p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Printf s p :: Type) x = String

type family GuardsT (ps :: [k]) where ... Source #

Equations

GuardsT '[] = '[] 
GuardsT (p ': ps) = Guard' p ': GuardsT ps 

type Guards' (ps :: [k]) = Para (GuardsT ps) Source #

type ToPara (os :: [k]) = Proxy (ParaImplW True os) Source #

type ToGuards (prt :: k) (os :: [k1]) = Proxy (Guards (ToGuardsT prt os)) Source #

type family ToGuardsT (prt :: k) (os :: [k1]) :: [(k, k1)] where ... Source #

Equations

ToGuardsT prt '[p] = '(prt, p) ': '[] 
ToGuardsT prt (p ': ps) = '(prt, p) ': ToGuardsT prt ps 

data ParaImpl (n :: Nat) (strict :: Bool) (os :: [k]) Source #

runs values in parallel unlike Do

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Para '[Id,Id + 1,Id * 4]) [10,20,30]
Present [10,21,120]
PresentT [10,21,120]
Instances
(TypeError (Text "ParaImpl '[] invalid: requires at least one value in the list") :: Constraint) => P (ParaImpl n strict ([] :: [k]) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict []) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict []) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict []) [a])) Source #

(KnownNat n, GetBool strict, GetLen ps, P p a, P (ParaImpl n strict (p1 ': ps)) [a], PP (ParaImpl n strict (p1 ': ps)) [a] ~ [PP p a], Show a, Show (PP p a)) => P (ParaImpl n strict (p ': (p1 ': ps)) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict (p ': (p1 ': ps))) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict (p ': (p1 ': ps))) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict (p ': (p1 ': ps))) [a])) Source #

(Show (PP p a), KnownNat n, GetBool strict, Show a, P p a) => P (ParaImpl n strict (p ': ([] :: [k])) :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImpl n strict (p ': [])) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImpl n strict (p ': [])) -> POpts -> [a] -> m (TT (PP (ParaImpl n strict (p ': [])) [a])) Source #

type PP (ParaImpl n strict (p ': (p1 ': ps)) :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (ParaImpl n strict (p ': (p1 ': ps)) :: Type) [a] = [PP p a]
type PP (ParaImpl n strict (p ': ([] :: [k])) :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (ParaImpl n strict (p ': ([] :: [k])) :: Type) [a] = [PP p a]
type PP (ParaImpl n strict ([] :: [k]) :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (ParaImpl n strict ([] :: [k]) :: Type) [a] = Void

type Para (os :: [k]) = ParaImplW True os Source #

type ParaLax (os :: [k]) = ParaImplW False os Source #

data ParaImplW (strict :: Bool) (ps :: [k]) Source #

Instances
(GetBool strict, GetLen ps, P (ParaImpl (LenT ps) strict ps) [a]) => P (ParaImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ParaImplW strict ps) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (ParaImplW strict ps) -> POpts -> [a] -> m (TT (PP (ParaImplW strict ps) [a])) Source #

type PP (ParaImplW strict ps :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (ParaImplW strict ps :: Type) [a] = PP (ParaImpl (LenT ps) strict ps) [a]

type family GuardsViaParaT prt ps where ... Source #

Equations

GuardsViaParaT prt '[] = '[] 
GuardsViaParaT prt (p ': ps) = Guard prt p ': GuardsViaParaT prt ps 

type GuardsViaPara prt ps = Para (GuardsViaParaT prt ps) Source #

data CaseImpl (n :: Nat) (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2) Source #

tries each predicate ps and on the first match runs the corresponding qs but if there is no match on ps then runs the fail case e

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Case (FailS "asdf" >> Snd >> Unproxy ) '[Lt 4,Lt 10,Same 50] '[Printf "%d is lt4" Id, Printf "%d is lt10" Id, Printf "%d is same50" Id] Id) 50
Present "50 is same50"
PresentT "50 is same50"
>>> pl @(Case (FailS "asdf" >> Snd >> Unproxy ) '[Lt 4,Lt 10,Same 50] '[Printf "%d is lt4" Id, Printf "%d is lt10" Id, Printf "%d is same50" Id] Id) 9
Present "9 is lt10"
PresentT "9 is lt10"
>>> pl @(Case (FailS "asdf" >> Snd >> Unproxy ) '[Lt 4,Lt 10,Same 50] '[Printf "%d is lt4" Id, Printf "%d is lt10" Id, Printf "%d is same50" Id] Id) 3
Present "3 is lt4"
PresentT "3 is lt4"
>>> pl @(Case (FailS "asdf" >> Snd >> Unproxy ) '[Lt 4,Lt 10,Same 50] '[Printf "%d is lt4" Id, Printf "%d is lt10" Id, Printf "%d is same50" Id] Id) 99
Error asdf
FailT "asdf"
Instances
(KnownNat n, GetLen ps, P r x, P p (PP r x), P q (PP r x), PP p (PP r x) ~ Bool, Show (PP q (PP r x)), Show (PP r x), P (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x, PP (CaseImpl n e (p1 ': ps) (q1 ': qs) r) x ~ PP q (PP r x)) => P (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r) x)) Source #

(P r x, P q (PP r x), Show (PP q (PP r x)), P p (PP r x), PP p (PP r x) ~ Bool, KnownNat n, Show (PP r x), P e (PP r x, Proxy (PP q (PP r x))), PP e (PP r x, Proxy (PP q (PP r x))) ~ PP q (PP r x)) => P (CaseImpl n e (p ': ([] :: [k])) (q ': ([] :: [k1])) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': []) (q ': []) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': []) (q ': []) r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': []) (q ': []) r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: lists are both empty") :: Constraint) => P (CaseImpl n e ([] :: [k]) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e [] [] r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e [] [] r) -> POpts -> x -> m (TT (PP (CaseImpl n e [] [] r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: rhs requires at least one value in the list") :: Constraint) => P (CaseImpl n e (p ': ps) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e (p ': ps) [] r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e (p ': ps) [] r) -> POpts -> x -> m (TT (PP (CaseImpl n e (p ': ps) [] r) x)) Source #

(TypeError (Text "CaseImpl '[] invalid: lhs requires at least one value in the list") :: Constraint) => P (CaseImpl n e ([] :: [k]) (q ': qs) r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (CaseImpl n e [] (q ': qs) r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (CaseImpl n e [] (q ': qs) r) -> POpts -> x -> m (TT (PP (CaseImpl n e [] (q ': qs) r) x)) Source #

type PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (CaseImpl n e (p ': (p1 ': ps)) (q ': (q1 ': qs)) r :: Type) x = PP q (PP r x)
type PP (CaseImpl n e (p ': ([] :: [k])) (q ': ([] :: [k1])) r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (CaseImpl n e (p ': ([] :: [k])) (q ': ([] :: [k1])) r :: Type) x = PP q (PP r x)
type PP (CaseImpl n e ([] :: [k]) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (CaseImpl n e ([] :: [k]) ([] :: [k1]) r :: Type) x = Void
type PP (CaseImpl n e (p ': ps) ([] :: [k1]) r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (CaseImpl n e (p ': ps) ([] :: [k1]) r :: Type) x = Void
type PP (CaseImpl n e ([] :: [k]) (q ': qs) r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (CaseImpl n e ([] :: [k]) (q ': qs) r :: Type) x = Void

data Case (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2) Source #

Instances
(FailIfT (NotT (LenT ps == LenT qs)) (((Text "lengths are not the same " :<>: ShowType (LenT ps)) :<>: Text " vs ") :<>: ShowType (LenT qs)), P (CaseImpl (LenT ps) e ps qs r) x) => P (Case e ps qs r :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Case e ps qs r) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Case e ps qs r) -> POpts -> x -> m (TT (PP (Case e ps qs r) x)) Source #

type PP (Case e ps qs r :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Case e ps qs r :: Type) x = PP (CaseImpl (LenT ps) e ps qs r) x

type Case' (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (Snd >> Failp "Case:no match") ps qs r Source #

type Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2) = Case (FailCase s) ps qs r Source #

data Sequence Source #

similar to sequenceA

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Sequence [Just 10, Just 20, Just 30]
Present Just [10,20,30]
PresentT (Just [10,20,30])
>>> pl @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]
Present Nothing
PresentT Nothing
Instances
(Show (f (t a)), Show (t (f a)), Traversable t, Applicative f) => P Sequence (t (f a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Sequence (t (f a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Sequence -> POpts -> t (f a) -> m (TT (PP Sequence (t (f a)))) Source #

type PP Sequence (t (f a)) Source # 
Instance details

Defined in Predicate

type PP Sequence (t (f a)) = f (t a)

type Traverse p q = Map p q >> Sequence Source #

data Hide p Source #

Instances
P p a => P (Hide p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Hide p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (Hide p) -> POpts -> a -> m (TT (PP (Hide p) a)) Source #

type PP (Hide p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (Hide p :: Type) a = PP p a

type H = Hide Source #

data ReadFile p Source #

similar to readFile

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(ReadFile ".ghci" >> 'Just Id >> Len >> Gt 0) ()
True
TrueT
>>> pl @(FileExists "xyzzy") ()
False
FalseT
Instances
(PP p x ~ String, P p x) => P (ReadFile p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadFile p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadFile p) -> POpts -> x -> m (TT (PP (ReadFile p) x)) Source #

type PP (ReadFile p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReadFile p :: Type) x = Maybe String

data ReadDir p Source #

does the directory exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(DirExists ".") ()
True
TrueT
Instances
(PP p x ~ String, P p x) => P (ReadDir p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadDir p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadDir p) -> POpts -> x -> m (TT (PP (ReadDir p) x)) Source #

type PP (ReadDir p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReadDir p :: Type) x = Maybe [FilePath]

data ReadEnv p Source #

does the directory exists

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(DirExists ".") ()
True
TrueT
Instances
(PP p x ~ String, P p x) => P (ReadEnv p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (ReadEnv p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (ReadEnv p) -> POpts -> x -> m (TT (PP (ReadEnv p) x)) Source #

type PP (ReadEnv p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (ReadEnv p :: Type) x = Maybe String

data ReadEnvAll Source #

Instances
P ReadEnvAll a Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReadEnvAll a :: Type Source #

Methods

eval :: MonadEval m => Proxy ReadEnvAll -> POpts -> a -> m (TT (PP ReadEnvAll a)) Source #

type PP ReadEnvAll a Source # 
Instance details

Defined in Predicate

type PP ReadEnvAll a = [(String, String)]

data TimeU Source #

Instances
P TimeU a Source # 
Instance details

Defined in Predicate

Associated Types

type PP TimeU a :: Type Source #

Methods

eval :: MonadEval m => Proxy TimeU -> POpts -> a -> m (TT (PP TimeU a)) Source #

type PP TimeU a Source # 
Instance details

Defined in Predicate

type PP TimeU a = UTCTime

data TimeZ Source #

Instances
P TimeZ a Source # 
Instance details

Defined in Predicate

Associated Types

type PP TimeZ a :: Type Source #

Methods

eval :: MonadEval m => Proxy TimeZ -> POpts -> a -> m (TT (PP TimeZ a)) Source #

type PP TimeZ a Source # 
Instance details

Defined in Predicate

type PP TimeZ a = ZonedTime

data FHandle s Source #

Constructors

FStdout 
FStderr 
FOther s WFMode 
Instances
Show s => Show (FHandle s) Source # 
Instance details

Defined in Predicate

Methods

showsPrec :: Int -> FHandle s -> ShowS #

show :: FHandle s -> String #

showList :: [FHandle s] -> ShowS #

class GetFHandle (x :: FHandle Symbol) where Source #

Instances
GetFHandle (FStdout :: FHandle Symbol) Source # 
Instance details

Defined in Predicate

GetFHandle (FStderr :: FHandle Symbol) Source # 
Instance details

Defined in Predicate

(GetMode w, KnownSymbol s) => GetFHandle (FOther s w) Source # 
Instance details

Defined in Predicate

data WFMode Source #

Constructors

WFAppend 
WFWrite 
WFWriteForce 
Instances
Eq WFMode Source # 
Instance details

Defined in Predicate

Methods

(==) :: WFMode -> WFMode -> Bool #

(/=) :: WFMode -> WFMode -> Bool #

Show WFMode Source # 
Instance details

Defined in Predicate

class GetMode (x :: WFMode) where Source #

Instances
GetMode WFAppend Source # 
Instance details

Defined in Predicate

GetMode WFWrite Source # 
Instance details

Defined in Predicate

GetMode WFWriteForce Source # 
Instance details

Defined in Predicate

data WritefileImpl (hh :: FHandle Symbol) p Source #

Instances
(GetFHandle fh, P p a, PP p a ~ String) => P (WritefileImpl fh p :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (WritefileImpl fh p) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (WritefileImpl fh p) -> POpts -> a -> m (TT (PP (WritefileImpl fh p) a)) Source #

type PP (WritefileImpl fh p :: Type) a Source # 
Instance details

Defined in Predicate

type PP (WritefileImpl fh p :: Type) a = ()

data Stdin Source #

Instances
P Stdin a Source # 
Instance details

Defined in Predicate

Associated Types

type PP Stdin a :: Type Source #

Methods

eval :: MonadEval m => Proxy Stdin -> POpts -> a -> m (TT (PP Stdin a)) Source #

type PP Stdin a Source # 
Instance details

Defined in Predicate

type PP Stdin a = String

type Nothing' = Guard "expected Nothing" IsNothing Source #

data IsFixImpl (cmp :: Ordering) (ignore :: Bool) p q Source #

isInfixOf isPrefixOf isSuffixOf equivalents

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(IsInfixI "abc" "axAbCd") ()
True
TrueT
>>> pl @(IsPrefixI "abc" "aBcbCd") ()
True
TrueT
>>> pl @(IsPrefix "abc" "aBcbCd") ()
False
FalseT

prefix infix suffix for strings

Instances
(GetBool ignore, P p a, P q a, PP p a ~ String, PP q a ~ String, GetOrdering cmp) => P (IsFixImpl cmp ignore p q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (IsFixImpl cmp ignore p q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (IsFixImpl cmp ignore p q) -> POpts -> a -> m (TT (PP (IsFixImpl cmp ignore p q) a)) Source #

type PP (IsFixImpl cmp ignore p q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (IsFixImpl cmp ignore p q :: Type) a = Bool

type IsInfix p q = IsFixImpl EQ False p q Source #

type IsInfixI p q = IsFixImpl EQ True p q Source #

data p <> q infixr 6 Source #

similar to <>

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst <> Snd) ("abc","def")
Present "abcdef"
PresentT "abcdef"
Instances
(Semigroup (PP p a), PP p a ~ PP q a, P p a, Show (PP q a), P q a) => P (p <> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <> q) -> POpts -> a -> m (TT (PP (p <> q) a)) Source #

type PP (p <> q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p <> q :: Type) a = PP p a

type Sapa' (t :: Type) = Wrap t Fst <> Wrap t Snd Source #

runPQ :: (P p a, P q a, MonadEval m) => String -> Proxy p -> Proxy q -> POpts -> a -> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))) Source #

class PrintC x where Source #

Methods

prtC :: (PrintfArg a, PrintfType r) => String -> (a, x) -> r Source #

Instances
PrintC () Source # 
Instance details

Defined in Predicate

Methods

prtC :: (PrintfArg a, PrintfType r) => String -> (a, ()) -> r Source #

(PrintfArg a, PrintC rs) => PrintC (a, rs) Source # 
Instance details

Defined in Predicate

Methods

prtC :: (PrintfArg a0, PrintfType r) => String -> (a0, (a, rs)) -> r Source #

data TupleListImpl (strict :: Bool) (n :: Nat) Source #

Instances
(Show a, KnownNat n, GetBool strict, TupleListD (ToN n) a, Show (TupleListT (ToN n) a)) => P (TupleListImpl strict n :: Type) [a] Source # 
Instance details

Defined in Predicate

Associated Types

type PP (TupleListImpl strict n) [a] :: Type Source #

Methods

eval :: MonadEval m => Proxy (TupleListImpl strict n) -> POpts -> [a] -> m (TT (PP (TupleListImpl strict n) [a])) Source #

type PP (TupleListImpl strict n :: Type) [a] Source # 
Instance details

Defined in Predicate

type PP (TupleListImpl strict n :: Type) [a] = TupleListT (ToN n) a

data ReverseTupleN Source #

Instances
(ReverseTupleC tp, Show (ReverseTupleP tp), Show tp) => P ReverseTupleN tp Source # 
Instance details

Defined in Predicate

Associated Types

type PP ReverseTupleN tp :: Type Source #

Methods

eval :: MonadEval m => Proxy ReverseTupleN -> POpts -> tp -> m (TT (PP ReverseTupleN tp)) Source #

type PP ReverseTupleN tp Source # 
Instance details

Defined in Predicate

data Printfn s p Source #

Printfn prints

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Printfn "%s %s" Id) ("123",("def",()))
Present "123 def"
PresentT "123 def"
>>> pl @(Printfn "s=%s d=%03d" Id) ("ab",(123,()))
Present "s=ab d=123"
PresentT "s=ab d=123"
Instances
(KnownNat (TupleLenT as), PrintC bs, (b, bs) ~ ReverseTupleP (a, as), ReverseTupleC (a, as), Show a, Show as, PrintfArg b, PP s x ~ String, PP p x ~ (a, as), P s x, P p x, CheckT (PP p x) ~ True) => P (Printfn s p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Printfn s p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Printfn s p) -> POpts -> x -> m (TT (PP (Printfn s p) x)) Source #

type PP (Printfn s p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Printfn s p :: Type) x = String

type Printfnt (n :: Nat) s = Printfn s (TupleList n) Source #

type PrintfntLax (n :: Nat) s = Printfn s (TupleListLax n) Source #

type Printf2 (s :: Symbol) = Printfn s '(Fst, '(Snd, ())) Source #

type Printf3 (s :: Symbol) = Printfn s '(Fst, '(Snd >> Fst, '(Snd >> Snd, ()))) Source #

type family CheckT (tp :: Type) :: Bool where ... Source #

Equations

CheckT () = TypeError (Text "Printfn: inductive tuple cannot be empty") 
CheckT o = True 

type family ApplyConstT (ta :: Type) (b :: Type) :: Type where ... Source #

Equations

ApplyConstT (t a) b = t b 
ApplyConstT ta b = TypeError ((Text "ApplyConstT: (t a) b but found something else" :$$: (Text "t a = " :<>: ShowType ta)) :$$: (Text "b = " :<>: ShowType b)) 

data p <$ q infixl 4 Source #

similar to <$

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst <$ Snd) ("abc",Just 20)
Present Just "abc"
PresentT (Just "abc")
Instances
(P p a, P q a, Show (PP p a), Functor t, PP q a ~ t c, ApplyConstT (PP q a) (PP p a) ~ t (PP p a)) => P (p <$ q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <$ q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <$ q) -> POpts -> a -> m (TT (PP (p <$ q) a)) Source #

type PP (p <$ q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p <$ q :: Type) a = ApplyConstT (PP q a) (PP p a)

data p <* q infixl 4 Source #

Instances
(Show (t c), P p a, P q a, Show (t b), Applicative t, t b ~ PP p a, PP q a ~ t c) => P (p <* q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <* q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <* q) -> POpts -> a -> m (TT (PP (p <* q) a)) Source #

type PP (p <* q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p <* q :: Type) a = PP p a

type (*>) p q = q <* p infixl 4 Source #

similar to <*

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst <* Snd) (Just "abc",Just 20)
Present Just "abc"
PresentT (Just "abc")

data p <|> q infixl 3 Source #

similar to <|>

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Fst <|> Snd) (Nothing,Just 20)
Present Just 20
PresentT (Just 20)
>>> pl @(Fst <|> Snd) (Just 10,Just 20)
Present Just 10
PresentT (Just 10)
>>> pl @(Fst <|> Snd) (Nothing,Nothing)
Present Nothing
PresentT Nothing
Instances
(P p a, P q a, Show (t b), Alternative t, t b ~ PP p a, PP q a ~ t b) => P (p <|> q :: Type) a Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p <|> q) a :: Type Source #

Methods

eval :: MonadEval m => Proxy (p <|> q) -> POpts -> a -> m (TT (PP (p <|> q) a)) Source #

type PP (p <|> q :: Type) a Source # 
Instance details

Defined in Predicate

type PP (p <|> q :: Type) a = PP p a

data Extract Source #

similar to extract

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Extract (Nothing,Just 20)
Present Just 20
PresentT (Just 20)
>>> pl @Extract (Identity 20)
Present 20
PresentT 20
Instances
(Show (t a), Show a, Comonad t) => P Extract (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Extract (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Extract -> POpts -> t a -> m (TT (PP Extract (t a))) Source #

type PP Extract (t a) Source # 
Instance details

Defined in Predicate

type PP Extract (t a) = a

data Duplicate Source #

similar to duplicate

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Duplicate (20,"abc")
Present (20,(20,"abc"))
PresentT (20,(20,"abc"))
Instances
(Show (t a), Show (t (t a)), Comonad t) => P Duplicate (t a) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Duplicate (t a) :: Type Source #

Methods

eval :: MonadEval m => Proxy Duplicate -> POpts -> t a -> m (TT (PP Duplicate (t a))) Source #

type PP Duplicate (t a) Source # 
Instance details

Defined in Predicate

type PP Duplicate (t a) = t (t a)

data Join Source #

similar to join

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @Join  (Just (Just 20))
Present Just 20
PresentT (Just 20)
Instances
(Show (t (t a)), Show (t a), Monad t) => P Join (t (t a)) Source # 
Instance details

Defined in Predicate

Associated Types

type PP Join (t (t a)) :: Type Source #

Methods

eval :: MonadEval m => Proxy Join -> POpts -> t (t a) -> m (TT (PP Join (t (t a)))) Source #

type PP Join (t (t a)) Source # 
Instance details

Defined in Predicate

type PP Join (t (t a)) = t a

data p $ q infixl 0 Source #

Instances
(P p x, P q x, PP p x ~ (a -> b), FnT (PP p x) ~ b, PP q x ~ a, Show a, Show b) => P (p $ q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (p $ q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (p $ q) -> POpts -> x -> m (TT (PP (p $ q) x)) Source #

type PP (p $ q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (p $ q :: Type) x = FnT (PP p x)

type (&) p q = q $ p infixr 1 Source #

type family FnT ab :: Type where ... Source #

Equations

FnT (a -> b) = b 
FnT ab = TypeError (Text "FnT: expected Type -> Type but found a simple Type?" :$$: (Text "ab = " :<>: ShowType ab)) 

evalQuick :: forall p i. P p i => i -> Either String (PP p i) Source #

data Trim' (left :: Bool) (right :: Bool) p Source #

similar to strip stripStart stripEnd

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(Trim Snd) (20," abc   " :: String)
Present "abc"
PresentT "abc"
>>> import Data.Text (Text)
>>> pl @(Trim Snd) (20," abc   " :: Text)
Present "abc"
PresentT "abc"
>>> pl @(TrimStart Snd) (20," abc   ")
Present "abc   "
PresentT "abc   "
>>> pl @(TrimEnd Snd) (20," abc   ")
Present " abc"
PresentT " abc"

todo: make it work for IsText

Instances
(FailIfT (NotT (OrT l r)) (Text "Trim': left and right cannot both be False"), GetBool l, GetBool r, IsText (PP p x), P p x) => P (Trim' l r p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (Trim' l r p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (Trim' l r p) -> POpts -> x -> m (TT (PP (Trim' l r p) x)) Source #

type PP (Trim' l r p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (Trim' l r p :: Type) x = PP p x

type Trim p = Trim' True True p Source #

data StripLR (right :: Bool) p q Source #

similar to stripLeft stripRight

>>> :set -XTypeApplications
>>> :set -XDataKinds
>>> pl @(StripLeft "xyz" Id) ("xyzHello" :: String)
Present Just "Hello"
PresentT (Just "Hello")
>>> import Data.Text (Text)
>>> pl @(StripLeft "xyz" Id) ("xyzHello" :: Text)
Present Just "Hello"
PresentT (Just "Hello")
>>> pl @(StripLeft "xyz" Id) "xywHello"
Present Nothing
PresentT Nothing
>>> pl @(StripRight "xyz" Id) "Hello xyz"
Present Just "Hello "
PresentT (Just "Hello ")
>>> pl @(StripRight "xyz" Id) "xyzHelloxyw"
Present Nothing
PresentT Nothing
Instances
(GetBool r, PP p x ~ String, P p x, IsText (PP q x), P q x) => P (StripLR r p q :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (StripLR r p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (StripLR r p q) -> POpts -> x -> m (TT (PP (StripLR r p q) x)) Source #

type PP (StripLR r p q :: Type) x Source # 
Instance details

Defined in Predicate

type PP (StripLR r p q :: Type) x = Maybe (PP q x)

type StripRight p q = StripLR True p q Source #

type StripLeft p q = StripLR False p q Source #

data RepeatP (n :: Nat) p Source #

Instances
P (RepeatT n p) x => P (RepeatP n p :: Type) x Source # 
Instance details

Defined in Predicate

Associated Types

type PP (RepeatP n p) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (RepeatP n p) -> POpts -> x -> m (TT (PP (RepeatP n p) x)) Source #

type PP (RepeatP n p :: Type) x Source # 
Instance details

Defined in Predicate

type PP (RepeatP n p :: Type) x = PP (RepeatT n p) x