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

Safe HaskellNone
LanguageHaskell2010

Predicate.Prelude

Contents

Description

Dsl for evaluating and displaying type level expressions

Contains instances of the class P for evaluating expressions at the type level.

Synopsis

boolean expressions

data p && q infixr 3 Source #

similar to &&

>>> pz @(Fst Id && Snd Id) (True, True)
TrueT
>>> pz @(Id > 15 && Id < 17) 16
TrueT
>>> pz @(Id > 15 && Id < 17) 30
FalseT
>>> pz @(Fst Id && (Length (Snd Id) >= 4)) (True,[11,12,13,14])
TrueT
>>> pz @(Fst Id && (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
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.Prelude

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.Prelude

type PP (p && q :: Type) a = Bool

data p &&~ q infixr 3 Source #

short circuit version of boolean And

>>> pl @(Id > 10 &&~ Failt _ "ss") 9
False (False &&~ ... | (9 > 10))
FalseT
>>> pl @(Id > 10 &&~ Id == 12) 11
False (True &&~ False | (11 == 12))
FalseT
>>> pl @(Id > 10 &&~ Id == 11) 11
True (True &&~ 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.Prelude

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.Prelude

type PP (p &&~ q :: Type) a = Bool

data p || q infixr 2 Source #

similar to ||

>>> pz @(Fst Id || (Length (Snd Id) >= 4)) (False,[11,12,13,14])
TrueT
>>> pz @(Not (Fst Id) || (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
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.Prelude

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.Prelude

type PP (p || q :: Type) a = Bool

data p ||~ q infixr 2 Source #

short circuit version of boolean Or

>>> pl @(Id > 10 ||~ Failt _ "ss") 11
True (True ||~ ...)
TrueT
>>> pz @(Id > 10 ||~ Id == 9) 9
TrueT
>>> pl @(Id > 10 ||~ Id > 9) 9
False (False ||~ False | (9 > 10) ||~ (9 > 9))
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.Prelude

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.Prelude

type PP (p ||~ q :: Type) a = Bool

data p ~> q infixr 1 Source #

implication

>>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (True,[11,12,13,14])
TrueT
>>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (True,[12,11,12,13,14])
FalseT
>>> pz @(Fst Id ~> (Length (Snd Id) == 4)) (False,[12,11,12,13,14])
TrueT
>>> pz @(Fst Id ~> (Length (Snd Id) >= 4)) (False,[11,12,13,14])
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.Prelude

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.Prelude

type PP (p ~> q :: Type) a = Bool

data Not p Source #

not function

>>> pz @(Not Id) False
TrueT
>>> pz @(Not Id) True
FalseT
>>> pz @(Not (Fst Id)) (True,22)
FalseT
>>> pl @(Not (Lt 3)) 13
True (Not (13 < 3))
TrueT
Instances
(PP p x ~ Bool, P p x) => P (Not p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Not p :: Type) x = Bool

data Ands p Source #

ands

>>> pz @(Ands Id) [True,True,True]
TrueT
>>> pl @(Ands Id) [True,True,True,False]
False (Ands(4) i=3 | [True,True,True,False])
FalseT
>>> pz @(Ands Id) []
TrueT
Instances
(PP p x ~ t a, P p x, Show (t a), Foldable t, a ~ Bool) => P (Ands p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Ands p :: Type) x = Bool

data Ors p Source #

ors

>>> pz @(Ors Id) [False,False,False]
FalseT
>>> pl @(Ors Id) [True,True,True,False]
True (Ors(4) i=0 | [True,True,True,False])
TrueT
>>> pl @(Ors Id) []
False (Ors(0) | [])
FalseT
Instances
(PP p x ~ t a, P p x, Show (t a), Foldable t, a ~ Bool) => P (Ors p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Ors p :: Type) x = Bool

data Asc Source #

a type level predicate for a monotonic increasing list

>>> pl @Asc "aaacdef"
True (All(6))
TrueT
>>> pz @Asc [1,2,3,4,5,5,7]
TrueT
>>> pz @Asc' [1,2,3,4,5,5,7]
FalseT
>>> pz @Asc "axacdef"
FalseT

a type level predicate for a monotonic increasing list

Instances
P AscT x => P Asc x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Asc x :: Type Source #

Methods

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

type PP Asc x Source # 
Instance details

Defined in Predicate.Prelude

type PP Asc x

data Asc' Source #

a type level predicate for a strictly increasing list

Instances
P AscT' x => P Asc' x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Asc' x :: Type Source #

Methods

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

type PP Asc' x Source # 
Instance details

Defined in Predicate.Prelude

type PP Asc' x

data Desc Source #

a type level predicate for a monotonic decreasing list

Instances
P DescT x => P Desc x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Desc x :: Type Source #

Methods

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

type PP Desc x Source # 
Instance details

Defined in Predicate.Prelude

type PP Desc x

data Desc' Source #

a type level predicate for a strictly decreasing list

Instances
P DescT' x => P Desc' x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Desc' x :: Type Source #

Methods

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

type PP Desc' x Source # 
Instance details

Defined in Predicate.Prelude

type PP Desc' x

data Between p q r Source #

A predicate that determines if the value is between 'p' and 'q'

>>> pz @(Between 5 8 Len) [1,2,3,4,5,5,7]
TrueT
>>> pz @(5 <..> 8) 6
TrueT
>>> pl @(Between 5 8 Id) 9
False (9 <= 8)
FalseT
>>> pz @(10 % 4 <..> 40 % 5) 4
TrueT
>>> pz @(10 % 4 <..> 40 % 5) 33
FalseT
Instances
(Ord (PP p x), Show (PP p x), PP r x ~ PP p x, PP r x ~ PP q x, P p x, P q x, P r x) => P (Between p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Between p q r :: Type) x = Bool

data BetweenA p q Source #

between for tuples

>>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),8)
False (8 <= 4)
FalseT
>>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),0)
False (1 <= 0)
FalseT
>>> pl @(BetweenA (Fst Id) (Snd Id)) ((1,4),3)
True (1 <= 3 <= 4)
TrueT
>>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2018-10-12"
True (2017-04-11 <= 2018-10-12 <= 2018-12-30)
TrueT
>>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
False (2019-10-12 <= 2018-12-30)
FalseT
>>> pl @(BetweenA (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
False (2017-04-11 <= 2016-10-12)
FalseT
Instances
(PP p x ~ (a, a'), P q x, PP q x ~ a, Ord a, a ~ a', Show a, P p x) => P (BetweenA p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (BetweenA p q :: Type) x = Bool

data p <..> q infix 4 Source #

Instances
P (BetweenT p q) x => P (p <..> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <..> q :: Type) x

data All p q Source #

similar to all

>>> pl @(All (Between 1 8 Id) Id) [7,3,4,1,2,9,0,1]
False (All(8) i=5 (9 <= 8))
FalseT
>>> pz @(All Odd Id) [1,5,11,5,3]
TrueT
>>> pz @(All Odd Id) []
TrueT
>>> pan @(All Even Id) [1,5,11,5,3]
False All(5) i=0 (1 == 0)
|
+- P Id [1,5,11,5,3]
|
+- False i=0:1 == 0
|  |
|  +- P 1 `mod` 2 = 1
|  |  |
|  |  +- P I
|  |  |
|  |  `- P '2
|  |
|  `- P '0
|
+- False i=1:1 == 0
|  |
|  +- P 5 `mod` 2 = 1
|  |  |
|  |  +- P I
|  |  |
|  |  `- P '2
|  |
|  `- P '0
|
+- False i=2:1 == 0
|  |
|  +- P 11 `mod` 2 = 1
|  |  |
|  |  +- P I
|  |  |
|  |  `- P '2
|  |
|  `- P '0
|
+- False i=3:1 == 0
|  |
|  +- P 5 `mod` 2 = 1
|  |  |
|  |  +- P I
|  |  |
|  |  `- P '2
|  |
|  `- P '0
|
`- False i=4:1 == 0
   |
   +- P 3 `mod` 2 = 1
   |  |
   |  +- P I
   |  |
   |  `- P '2
   |
   `- P '0
FalseT
Instances
(P p a, PP p a ~ Bool, PP q x ~ f a, P q x, Show a, Foldable f) => P (All p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (All p q :: Type) x = Bool

data Any p q Source #

similar to any

>>> pl @(Any Even Id) [1,5,11,5,3]
False (Any(5))
FalseT
>>> pl @(Any Even Id) [1,5,112,5,3]
True (Any(5) i=2 (0 == 0))
TrueT
>>> pz @(Any Even Id) []
FalseT
Instances
(P p a, PP p a ~ Bool, PP q x ~ f a, P q x, Show a, Foldable f) => P (Any p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Any p q :: Type) x = Bool

data AllPositive Source #

a type level predicate for all positive elements in a list

>>> pz @AllPositive [1,5,10,2,3]
TrueT
>>> pz @AllPositive [0,1,5,10,2,3]
FalseT
>>> pz @AllPositive [3,1,-5,10,2,3]
FalseT
>>> pz @AllNegative [-1,-5,-10,-2,-3]
TrueT
Instances
P AllPositiveT x => P AllPositive x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP AllPositive x :: Type Source #

Methods

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

type PP AllPositive x Source # 
Instance details

Defined in Predicate.Prelude

type Positive = Gt 0 Source #

data AllNegative Source #

a type level predicate for all negative elements in a list

Instances
P AllNegativeT x => P AllNegative x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP AllNegative x :: Type Source #

Methods

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

type PP AllNegative x Source # 
Instance details

Defined in Predicate.Prelude

type Negative = Lt 0 Source #

data AndA p q r Source #

like && but for a tuple

>>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) ()
False ((>>) False | {False (&*) True | (4 > 4)})
FalseT
Instances
(PP r x ~ (a, b), PP p a ~ Bool, PP q b ~ Bool, P p a, P q b, P r x) => P (AndA p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (AndA p q r :: Type) x = Bool

data p &* q infixr 3 Source #

Instances
P (AndAT p q) x => P (p &* q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p &* q :: Type) x

data OrA p q r Source #

like || but for a tuple

>>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,8,14,44],9)
True (True (|+) False)
TrueT
>>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],9)
False (False (|+) False | (32 > 44) (|+) (9 < 2))
FalseT
>>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],1)
True (False (|+) True)
TrueT
Instances
(PP r x ~ (a, b), PP p a ~ Bool, PP q b ~ Bool, P p a, P q b, P r x) => P (OrA p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (OrA p q r :: Type) x = Bool

data p |+ q infixr 3 Source #

Instances
P (OrAT p q) x => P (p |+ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p |+ q :: Type) x

data IdBool p Source #

id function on a boolean

>>> pz @(IdBool Id) False
FalseT
>>> pz @(IdBool Id) True
TrueT
>>> pz @(IdBool (Fst Id)) (True,22)
TrueT
>>> pl @(IdBool (Lt 3)) 13
False (IdBool (13 < 3))
FalseT
Instances
(PP p x ~ Bool, P p x) => P (IdBool p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IdBool p :: Type) x = Bool

regex expressions

data Re p q Source #

Instances
P (ReT p q) x => P (Re p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Re p q :: Type) x

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

>>> pz @(Re "^\\d{2}:\\d{2}:\\d{2}$" Id) "13:05:25"
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.Prelude

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.Prelude

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

data Rescan p q Source #

Instances
P (RescanT p q) x => P (Rescan p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Rescan p q :: Type) x

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

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

>>> pz @(Rescan "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
PresentT [("13:05:25",["13","05","25"])]
>>> pz @(Rescan (Snd Id) "13:05:25") ('a',"^(\\d{2}):(\\d{2}):(\\d{2})$")
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.Prelude

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.Prelude

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

data RescanRanges p q Source #

Instances
P (RescanRangesT p q) x => P (RescanRanges p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (RescanRanges p q :: Type) x

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

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

>>> pz @(RescanRanges "^(\\d{2}):(\\d{2}):(\\d{2})$" Id) "13:05:25"
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.Prelude

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.Prelude

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

data Resplit p q Source #

Instances
P (ResplitT p q) x => P (Resplit p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Resplit p q :: Type) x

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

splits a string on a regex delimiter

>>> pz @(Resplit "\\." Id) "141.201.1.22"
PresentT ["141","201","1","22"]
>>> pz @(Resplit (Singleton (Fst Id)) (Snd Id)) (':', "12:13:1")
PresentT ["12","13","1"]
>>> pl @(Resplit' '[ 'Caseless ] "aBc" Id) "123AbC456abc"
Present ["123","456",""] (Resplit (aBc) ["123","456",""] | 123AbC456abc)
PresentT ["123","456",""]
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.Prelude

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.Prelude

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

data ReplaceAll p q r Source #

Instances
P (ReplaceAllT p q r) x => P (ReplaceAll p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceAll p q r :: Type) x

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

Instances
P (ReplaceAllT' rs p q r) x => P (ReplaceAll' rs p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceAll' rs p q r :: Type) x

data ReplaceOne p q r Source #

replace first occurrence of string 'p' with '\q' in 'r'

>>> pl @(ReplaceOneString 'ROverWrite "abc" "def" Id) "123abc456abc"
Present "123def456abc" (ReplaceOne' [] (abc) 123abc456abc | 123def456abc)
PresentT "123def456abc"
>>> pz @(Rescan "^Date\\((\\d+[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1530144000123+0530)"
PresentT 2018-06-28 05:30:00.123 +0530
>>> pz @(Rescan "^Date\\((\\d+[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> Id !! 0 >> ReplaceOneString 'RPrepend "\\d{3}[+-]" "." Id >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1593460089052+0800)"
PresentT 2020-06-30 03:48:09.052 +0800
>>> pz @(Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" Id >> Head Id >> Snd Id >> (Id !! 0 <> "." <> Id !! 1)  >> ParseTimeP ZonedTime "%s%Q%z" Id) "Date(1593460089052+0800)"
PresentT 2020-06-30 03:48:09.052 +0800
Instances
P (ReplaceOneT p q r) x => P (ReplaceOne p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceOne p q r :: Type) x

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

Instances
P (ReplaceOneT' rs p q r) x => P (ReplaceOne' rs p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceOne' rs p q r :: Type) x

data ReplaceAllString o p q r Source #

Instances
P (ReplaceAllStringT o p q r) x => P (ReplaceAllString o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceAllString o p q r :: Type) x

data ReplaceAllString' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r Source #

replace all occurrences of string 'p' with '\q' in 'r'

>>> pl @(ReplaceAllString 'ROverWrite "abc" "def" Id) "123abc456abc"
Present "123def456def" (ReplaceAll' [] (abc) 123abc456abc | 123def456def)
PresentT "123def456def"
>>> pl @(ReplaceAllString' '[] 'ROverWrite "abc" "def" Id) "123AbC456abc"
Present "123AbC456def" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456def)
PresentT "123AbC456def"
>>> pl @(ReplaceAllString' '[ 'Caseless ] 'ROverWrite "abc" "def" Id) "123AbC456abc"
Present "123def456def" (ReplaceAll (abc) 123AbC456abc | 123def456def)
PresentT "123def456def"
>>> pl @(ReplaceAllString 'RPrepend "abc" "def" Id) "123AbC456abc"
Present "123AbC456defabc" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456defabc)
PresentT "123AbC456defabc"
>>> pl @(ReplaceAllString 'ROverWrite "abc" "def" Id) "123AbC456abc"
Present "123AbC456def" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456def)
PresentT "123AbC456def"
>>> pl @(ReplaceAllString 'RAppend "abc" "def" Id) "123AbC456abc"
Present "123AbC456abcdef" (ReplaceAll' [] (abc) 123AbC456abc | 123AbC456abcdef)
PresentT "123AbC456abcdef"
Instances
P (ReplaceAllStringT' rs o p q r) x => P (ReplaceAllString' rs o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ReplaceAllString' rs o p q r) x :: Type Source #

Methods

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

type PP (ReplaceAllString' rs o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (ReplaceAllString' rs o p q r :: Type) x

data ReplaceOneString (o :: ReplaceFnSub) p q r Source #

Instances
P (ReplaceOneStringT o p q r) x => P (ReplaceOneString o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceOneString o p q r :: Type) x

data ReplaceOneString' (rs :: [ROpt]) (o :: ReplaceFnSub) p q r Source #

Instances
P (ReplaceOneStringT' rs o p q r) x => P (ReplaceOneString' rs o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ReplaceOneString' rs o p q r) x :: Type Source #

Methods

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

type PP (ReplaceOneString' rs o p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (ReplaceOneString' rs o p q r :: Type) x

data ReplaceFn (o :: ReplaceFnSub) p Source #

Simple replacement string: see ReplaceAllString and ReplaceOneString

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

Defined in Predicate.Prelude

Associated Types

type PP (ReplaceFn r p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceFn r p :: Type) x = RReplace

data ReplaceFn1 p Source #

A replacement function (String -> [String] -> String) which returns the whole match and the groups Used by sub and gsub

Requires Text.Show.Functions

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceFn1 p :: Type) x = RReplace

data ReplaceFn2 p Source #

A replacement function (String -> String) that yields the whole match Used by sub and gsub

Requires Text.Show.Functions

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceFn2 p :: Type) x = RReplace

data ReplaceFn3 p Source #

A replacement function ([String] -> String) which yields the groups Used by sub and gsub

Requires Text.Show.Functions

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReplaceFn3 p :: Type) x = RReplace

tuple expressions

data Fst p Source #

similar to fst

>>> pz @(Fst Id) (10,"Abc")
PresentT 10
>>> pz @(Fst Id) (10,"Abc",'x')
PresentT 10
>>> pz @(Fst Id) (10,"Abc",'x',False)
PresentT 10
Instances
(Show (ExtractL1T (PP p x)), ExtractL1C (PP p x), P p x, Show (PP p x)) => P (Fst p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Fst p :: Type) x

data Snd p Source #

similar to snd

>>> pz @(Snd Id) (10,"Abc")
PresentT "Abc"
>>> pz @(Snd Id) (10,"Abc",True)
PresentT "Abc"
Instances
(Show (ExtractL2T (PP p x)), ExtractL2C (PP p x), P p x, Show (PP p x)) => P (Snd p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Snd p :: Type) x

data Thd p Source #

similar to 3rd element in a n-tuple

>>> pz @(Thd Id) (10,"Abc",133)
PresentT 133
>>> pz @(Thd Id) (10,"Abc",133,True)
PresentT 133
Instances
(Show (ExtractL3T (PP p x)), ExtractL3C (PP p x), P p x, Show (PP p x)) => P (Thd p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Thd p :: Type) x

data L1 p Source #

Instances
P (L1T p) x => P (L1 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L1 p :: Type) x

data L2 p Source #

Instances
P (L2T p) x => P (L2 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L2 p :: Type) x

data L3 p Source #

Instances
P (L3T p) x => P (L3 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L3 p :: Type) x

data L4 p Source #

similar to 4th element in a n-tuple

>>> pz @(L4 Id) (10,"Abc",'x',True)
PresentT True
>>> pz @(L4 (Fst (Snd Id))) ('x',((10,"Abc",'x',999),"aa",1),9)
PresentT 999
Instances
(Show (ExtractL4T (PP p x)), ExtractL4C (PP p x), P p x, Show (PP p x)) => P (L4 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L4 p :: Type) x

data L5 p Source #

similar to 5th element in a n-tuple

>>> pz @(L5 Id) (10,"Abc",'x',True,1)
PresentT 1
Instances
(Show (ExtractL5T (PP p x)), ExtractL5C (PP p x), P p x, Show (PP p x)) => P (L5 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L5 p :: Type) x

data L6 p Source #

similar to 6th element in a n-tuple

>>> pz @(L6 Id) (10,"Abc",'x',True,1,99)
PresentT 99
Instances
(Show (ExtractL6T (PP p x)), ExtractL6C (PP p x), P p x, Show (PP p x)) => P (L6 p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (L6 p :: Type) x

data Dup Source #

Instances
Show x => P Dup x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Dup x :: Type Source #

Methods

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

type PP Dup x Source # 
Instance details

Defined in Predicate.Prelude

type PP Dup x

data Swap Source #

swaps using SwapC

>>> pz @Swap (Left 123)
PresentT (Right 123)
>>> pz @Swap (Right 123)
PresentT (Left 123)
>>> pz @Swap (These 'x' 123)
PresentT (These 123 'x')
>>> pz @Swap (This 'x')
PresentT (That 'x')
>>> pz @Swap (That 123)
PresentT (This 123)
>>> pz @Swap (123,'x')
PresentT ('x',123)
>>> pz @Swap (Left "abc")
PresentT (Right "abc")
>>> pz @Swap (Right 123)
PresentT (Left 123)
Instances
(Show (p a b), SwapC p, Show (p b a)) => P Swap (p a b) Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Swap (p a b) = p b a

class Bifunctor p => SwapC p where Source #

Methods

swapC :: p a b -> p b a Source #

Instances
SwapC Either Source # 
Instance details

Defined in Predicate.Prelude

Methods

swapC :: Either a b -> Either b a Source #

SwapC (,) Source # 
Instance details

Defined in Predicate.Prelude

Methods

swapC :: (a, b) -> (b, a) Source #

SwapC These Source # 
Instance details

Defined in Predicate.Prelude

Methods

swapC :: These a b -> These b a Source #

data Assoc Source #

assoc using AssocC

>>> pz @Assoc (This (These 123 'x'))
PresentT (These 123 (This 'x'))
>>> pz @Assoc ((99,'a'),True)
PresentT (99,('a',True))
>>> pz @Assoc ((99,'a'),True)
PresentT (99,('a',True))
>>> pz @Assoc (Right "Abc" :: Either (Either () ()) String)
PresentT (Right (Right "Abc"))
>>> pz @Assoc (Left (Left 'x'))
PresentT (Left 'x')
Instances
(Show (p (p a b) c), Show (p a (p b c)), AssocC p) => P Assoc (p (p a b) c) Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Assoc (p (p a b) c) :: Type Source #

Methods

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

type PP Assoc (p (p a b) c) Source # 
Instance details

Defined in Predicate.Prelude

type PP Assoc (p (p a b) c) = p a (p b c)

data Unassoc Source #

unassoc using AssocC

>>> pz @Unassoc (These 123 (This 'x'))
PresentT (This (These 123 'x'))
>>> pz @Unassoc (99,('a',True))
PresentT ((99,'a'),True)
>>> pz @Unassoc (This 10 :: These Int (These Bool ()))
PresentT (This (This 10))
>>> pz @Unassoc (Right (Right 123))
PresentT (Right 123)
>>> pz @Unassoc (Left 'x' :: Either Char (Either Bool Double))
PresentT (Left (Left 'x'))
Instances
(Show (p (p a b) c), Show (p a (p b c)), AssocC p) => P Unassoc (p a (p b c)) Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Unassoc (p a (p b c)) :: Type Source #

Methods

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

type PP Unassoc (p a (p b c)) Source # 
Instance details

Defined in Predicate.Prelude

type PP Unassoc (p a (p b c)) = p (p a b) c

data Pairs Source #

creates a list of overlapping pairs of elements. requires two or more elements

>>> pz @Pairs [1,2,3,4]
PresentT [(1,2),(2,3),(3,4)]
>>> pz @Pairs []
FailT "Pairs no data found"
>>> pz @Pairs [1]
FailT "Pairs only one element found"
Instances
Show a => P Pairs [a] Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Pairs [a] = [(a, a)]

character expressions

data IsLower Source #

predicate for determining if a character is lowercase

>>> pz @IsLower '1'
FalseT
>>> pz @IsLower 'a'
TrueT
>>> pz @(Map '(IsControl, IsLatin1, IsHexDigit, IsOctDigit, IsDigit, IsPunctuation, IsSeparator, IsSpace) Id) "abc134"
PresentT [(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,False,False,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False),(False,True,True,True,True,False,False,False)]
Instances
P IsLowerT x => P IsLower x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsLower x :: Type Source #

Methods

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

type PP IsLower x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsLower x

data IsUpper Source #

Instances
P IsUpperT x => P IsUpper x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsUpper x :: Type Source #

Methods

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

type PP IsUpper x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsUpper x

data IsDigit Source #

predicate for determining if the character is a digit

>>> pz @IsDigit 'g'
FalseT
>>> pz @IsDigit '9'
TrueT
Instances
P IsDigitT x => P IsDigit x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsDigit x :: Type Source #

Methods

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

type PP IsDigit x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsDigit x = Bool

data IsSpace Source #

Instances
P IsSpaceT x => P IsSpace x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsSpace x :: Type Source #

Methods

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

type PP IsSpace x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsSpace x = Bool

data IsPunctuation Source #

Instances
P IsPunctuationT x => P IsPunctuation x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsPunctuation x :: Type Source #

Methods

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

type PP IsPunctuation x Source # 
Instance details

Defined in Predicate.Prelude

data IsControl Source #

Instances
P IsControlT x => P IsControl x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsControl x :: Type Source #

Methods

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

type PP IsControl x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsControl x = Bool

data IsHexDigit Source #

Instances
P IsHexDigitT x => P IsHexDigit x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsHexDigit x :: Type Source #

Methods

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

type PP IsHexDigit x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsHexDigit x = Bool

data IsOctDigit Source #

Instances
P IsOctDigitT x => P IsOctDigit x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsOctDigit x :: Type Source #

Methods

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

type PP IsOctDigit x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsOctDigit x = Bool

data IsSeparator Source #

Instances
P IsSeparatorT x => P IsSeparator x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsSeparator x :: Type Source #

Methods

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

type PP IsSeparator x Source # 
Instance details

Defined in Predicate.Prelude

data IsLatin1 Source #

Instances
P IsLatin1T x => P IsLatin1 x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsLatin1 x :: Type Source #

Methods

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

type PP IsLatin1 x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsLatin1 x = Bool

data IsLowerAll Source #

Instances
P IsLowerAllT x => P IsLowerAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsLowerAll x :: Type Source #

Methods

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

type PP IsLowerAll x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsLowerAll x

data IsUpperAll Source #

Instances
P IsUpperAllT x => P IsUpperAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsUpperAll x :: Type Source #

Methods

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

type PP IsUpperAll x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsUpperAll x

data IsDigitAll Source #

predicate for determining if the string is all digits

>>> pz @IsDigitAll "213G"
FalseT
>>> pz @IsDigitAll "929"
TrueT
Instances
P IsDigitAllT x => P IsDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsDigitAll x :: Type Source #

Methods

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

type PP IsDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsDigitAll x = Bool

data IsSpaceAll Source #

predicate for determining if the string is all spaces

>>> pz @IsSpaceAll "213G"
FalseT
>>> pz @IsSpaceAll "    "
TrueT
>>> pz @IsSpaceAll ""
TrueT
Instances
P IsSpaceAllT x => P IsSpaceAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsSpaceAll x :: Type Source #

Methods

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

type PP IsSpaceAll x Source # 
Instance details

Defined in Predicate.Prelude

type PP IsSpaceAll x = Bool

data IsPunctuationAll Source #

Instances
P IsPunctuationAllT x => P IsPunctuationAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsPunctuationAll x :: Type Source #

type PP IsPunctuationAll x Source # 
Instance details

Defined in Predicate.Prelude

data IsControlAll Source #

Instances
P IsControlAllT x => P IsControlAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsControlAll x :: Type Source #

Methods

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

type PP IsControlAll x Source # 
Instance details

Defined in Predicate.Prelude

data IsHexDigitAll Source #

Instances
P IsHexDigitAllT x => P IsHexDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsHexDigitAll x :: Type Source #

Methods

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

type PP IsHexDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

data IsOctDigitAll Source #

Instances
P IsOctDigitAllT x => P IsOctDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsOctDigitAll x :: Type Source #

Methods

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

type PP IsOctDigitAll x Source # 
Instance details

Defined in Predicate.Prelude

data IsSeparatorAll Source #

Instances
P IsSeparatorAllT x => P IsSeparatorAll x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsSeparatorAll x :: Type Source #

Methods

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

type PP IsSeparatorAll x Source # 
Instance details

Defined in Predicate.Prelude

data IsLatin1All Source #

Instances
P IsLatin1AllT x => P IsLatin1All x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP IsLatin1All x :: Type Source #

Methods

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

type PP IsLatin1All x Source # 
Instance details

Defined in Predicate.Prelude

datetime expressions

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

>>> pz @(FormatTimeP "%F %T" Id) (readNote @LocalTime "invalid localtime" "2019-05-24 05:19:59")
PresentT "2019-05-24 05:19:59"
>>> pz @(FormatTimeP (Fst Id) (Snd Id)) ("the date is %d/%m/%Y", readNote @Day "invalid day" "2019-05-24")
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.Prelude

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.Prelude

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

data ParseTimeP (t :: Type) p q Source #

Instances
P (ParseTimePT t p q) x => P (ParseTimeP t p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ParseTimeP t p q :: Type) x

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

>>> pz @(ParseTimeP LocalTime "%F %T" Id) "2019-05-24 05:19:59"
PresentT 2019-05-24 05:19:59
>>> pz @(ParseTimeP LocalTime "%F %T" "2019-05-24 05:19:59") (Right "never used")
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.Prelude

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.Prelude

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

data ParseTimes (t :: Type) p q Source #

Instances
P (ParseTimesT t p q) x => P (ParseTimes t p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ParseTimes t p q :: Type) x

data ParseTimes' t p q Source #

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

>>> pz @(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") ()
PresentT 2019-03-11 01:22:33
>>> pz @(ParseTimes LocalTime (Fst Id) (Snd Id)) (["%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")
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.Prelude

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.Prelude

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

data MkDay p Source #

Instances
P (MkDayT p) x => P (MkDay p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MkDay p :: Type) x

data MkDay' p q r Source #

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

>>> pz @(MkDay '(1,2,3) >> Just Id) ()
PresentT 0001-02-03
>>> pz @(Just (MkDay '(1,2,3))) 1
PresentT 0001-02-03
>>> pz @(MkDay Id) (2019,12,30)
PresentT (Just 2019-12-30)
>>> pz @(MkDay' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
PresentT Nothing
>>> pz @(MkDay Id) (1999,3,13)
PresentT (Just 1999-03-13)
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.Prelude

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.Prelude

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

data UnMkDay p Source #

uncreate a Day returning year month and day

>>> pz @(UnMkDay Id) (readNote "invalid day" "2019-12-30")
PresentT (2019,12,30)
Instances
(PP p x ~ Day, P p x) => P (UnMkDay p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (UnMkDay p :: Type) x = (Int, Int, Int)

data MkDayExtra p Source #

Instances
P (MkDayExtraT p) x => P (MkDayExtra p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MkDayExtra p :: Type) x

data MkDayExtra' p q r Source #

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

>>> pz @(MkDayExtra '(1,2,3) >> Just Id >> Fst Id) ()
PresentT 0001-02-03
>>> pz @(Fst (Just (MkDayExtra '(1,2,3)))) 1
PresentT 0001-02-03
>>> pz @(MkDayExtra Id) (2019,12,30)
PresentT (Just (2019-12-30,1,1))
>>> pz @(MkDayExtra' (Fst Id) (Snd Id) (Thd Id)) (2019,99,99999)
PresentT Nothing
>>> pz @(MkDayExtra Id) (1999,3,13)
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 (MkDayExtra' p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

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

data ToWeekDate p Source #

get day of week

>>> pz @(Just (MkDay '(2020,7,11)) >> '(UnMkDay Id, ToWeekYear Id,ToWeekDate Id)) ()
PresentT ((2020,7,11),28,(6,"Saturday"))
Instances
(P p x, PP p x ~ Day) => P (ToWeekDate p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToWeekDate p :: Type) x = (Int, String)

data ToWeekYear p Source #

get week number of the year

>>> pz @(Just (MkDay '(2020,7,11)) >> ToWeekYear Id) ()
PresentT 28
Instances
(P p x, PP p x ~ Day) => P (ToWeekYear p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToWeekYear p :: Type) x = Int

data ToDay p Source #

extract Day from a DateTime

>>> pz @(ReadP UTCTime Id >> ToDay Id) "2020-07-06 12:11:13Z"
PresentT 2020-07-06
Instances
(P p x, Show (PP p x), ToDayC (PP p x)) => P (ToDay p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToDay p :: Type) x = Day

data ToTime p Source #

extract TimeOfDay from DateTime

>>> pz @(ReadP UTCTime Id >> ToDay Id) "2020-07-06 12:11:13Z"
PresentT 2020-07-06
Instances
(P p x, Show (PP p x), ToTimeC (PP p x)) => P (ToTime p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToTime p :: Type) x = TimeOfDay

data MkTime p Source #

Instances
P (MkTimeT p) x => P (MkTime p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MkTime p :: Type) x

data MkTime' p q r Source #

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

>>> pz @(MkTime '(1,2,3 % 12345)) ()
PresentT 01:02:00.000243013365
>>> pz @(MkTime Id) (12,13,65)
PresentT 12:13:65
>>> pz @(MkTime' (Fst Id) (Snd Id) (Thd Id)) (13,99,99999)
PresentT 13:99:99999
>>> pz @(MkTime Id) (17,3,13)
PresentT 17:03:13
Instances
(P p x, P q x, P r x, PP p x ~ Int, PP q x ~ Int, PP r x ~ Rational) => P (MkTime' p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MkTime' p q r :: Type) x = TimeOfDay

data UnMkTime p Source #

uncreate a TimeOfDay returning hour minute seconds picoseconds

>>> pz @(ReadP UTCTime "2019-01-01 12:13:14.1234Z" >> ToTime Id >> UnMkTime Id) ()
PresentT (12,13,70617 % 5000)
>>> pz @(ReadP UTCTime Id >> ToTime Id >> UnMkTime Id) "2020-07-22 08:01:14.127Z"
PresentT (8,1,14127 % 1000)
>>> pz @(ReadP ZonedTime Id >> '(UnMkDay (ToDay Id), UnMkTime (ToTime Id))) "2020-07-11 11:41:12.333 CET"
PresentT ((2020,7,11),(11,41,12333 % 1000))
Instances
(PP p x ~ TimeOfDay, P p x) => P (UnMkTime p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (UnMkTime p :: Type) x = (Int, Int, Rational)

data PosixToUTCTime p Source #

convert posix time (seconds since 01-01-1970) to UTCTime

>>> pl @(PosixToUTCTime Id) 1593384312
Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)
PresentT 2020-06-28 22:45:12 UTC
>>> pl @(PosixToUTCTime Id >> UTCTimeToPosix Id) 1593384312
Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})
PresentT (1593384312 % 1)
>>> pl @(PosixToUTCTime (Id % 1000)) 1593384312000
Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)
PresentT 2020-06-28 22:45:12 UTC
>>> pl @(PosixToUTCTime Id) (3600*4+60*7+12)
Present 1970-01-01 04:07:12 UTC (PosixToUTCTime 1970-01-01 04:07:12 UTC | 14832 % 1)
PresentT 1970-01-01 04:07:12 UTC
>>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" Id >> Head Id >> Snd Id >> ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) "Date(1530144000000+0530)"
PresentT 2018-06-28 00:00:00 UTC
Instances
(PP p x ~ Rational, P p x) => P (PosixToUTCTime p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (PosixToUTCTime p :: Type) x = UTCTime

data UTCTimeToPosix p Source #

convert UTCTime to posix time (seconds since 01-01-1970)

>>> pl @(ReadP UTCTime Id >> UTCTimeToPosix Id) "2020-06-28 22:45:12 UTC"
Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})
PresentT (1593384312 % 1)
>>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" Id >> Head Id >> Snd Id >> ((ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) &&& ReadP TimeZone (Id !! 1))) "Date(1530144000000+0530)"
PresentT (2018-06-28 00:00:00 UTC,+0530)

not so useful: instead use ParseTimeP FormatTimeP with %s %q %z etc

>>> pz @(ParseTimeP ZonedTime "%s%Q%z" Id)  "153014400.000+0530"
PresentT 1974-11-07 05:30:00 +0530
Instances
(PP p x ~ UTCTime, P p x) => P (UTCTimeToPosix p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (UTCTimeToPosix p :: Type) x = Rational

numeric expressions

data p + q infixl 6 Source #

Instances
P (AddT p q) x => P (p + q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p + q :: Type) x

data p - q infixl 6 Source #

Instances
P (SubT p q) x => P (p - q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p - q :: Type) x

data p * q infixl 7 Source #

Instances
P (MultT p q) x => P (p * q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p * q :: Type) x

data p / q infixl 7 Source #

fractional division

>>> pz @(Fst Id / Snd Id) (13,2)
PresentT 6.5
>>> pz @(ToRational 13 / Id) 0
FailT "(/) zero denominator"
>>> pz @(12 % 7 / 14 % 5 + Id) 12.4
PresentT (3188 % 245)
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 (p / q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p / q :: Type) a = PP p a

data Negate p Source #

similar to negate

>>> pz @(Negate Id) 14
PresentT (-14)
>>> pz @(Negate (Fst Id * Snd Id)) (14,3)
PresentT (-42)
>>> pz @(Negate (15 -% 4)) "abc"
PresentT (15 % 4)
>>> pz @(Negate (15 % 3)) ()
PresentT ((-5) % 1)
>>> pz @(Negate (Fst Id % Snd Id)) (14,3)
PresentT ((-14) % 3)
Instances
(Show (PP p x), Num (PP p x), P p x) => P (Negate p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Negate p :: Type) x = PP p x

data Abs p Source #

similar to abs

>>> pz @(Abs Id) (-14)
PresentT 14
>>> pz @(Abs (Snd Id)) ("xx",14)
PresentT 14
>>> pz @(Abs Id) 0
PresentT 0
>>> pz @(Abs (Negate 44)) "aaa"
PresentT 44
Instances
(Show (PP p x), Num (PP p x), P p x) => P (Abs p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Abs p :: Type) x = PP p x

data Signum p Source #

similar to signum

>>> pz @(Signum Id) (-14)
PresentT (-1)
>>> pz @(Signum Id) 14
PresentT 1
>>> pz @(Signum Id) 0
PresentT 0
Instances
(Show (PP p x), Num (PP p x), P p x) => P (Signum p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Signum p :: Type) x = PP p x

data FromInteger (t :: Type) p Source #

Instances
P (FromIntegerT t p) x => P (FromInteger t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FromInteger t p :: Type) x

data FromInteger' t n Source #

fromInteger function where you need to provide the type 't' of the result

>>> pz @(FromInteger (SG.Sum _) Id) 23
PresentT (Sum {getSum = 23})
>>> pz @(FromInteger Rational 44) 12
PresentT (44 % 1)
>>> pz @(FromInteger Rational Id) 12
PresentT (12 % 1)
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.Prelude

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.Prelude

type PP (FromInteger' t n :: Type) a = PP t a

data FromIntegral (t :: Type) p Source #

Instances
P (FromIntegralT t p) x => P (FromIntegral t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FromIntegral t p :: Type) x

data FromIntegral' t n Source #

fromIntegral function where you need to provide the type 't' of the result

>>> pz @(FromIntegral (SG.Sum _) Id) 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.Prelude

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.Prelude

type PP (FromIntegral' t n :: Type) a = PP t a

data Truncate (t :: Type) p Source #

Instances
P (TruncateT t p) x => P (Truncate t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Truncate t p :: Type) x

data Truncate' t p Source #

truncate function where you need to provide the type 't' of the result

>>> pz @(Truncate Int Id) (23 % 5)
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.Prelude

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.Prelude

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

data Ceiling (t :: Type) p Source #

Instances
P (CeilingT t p) x => P (Ceiling t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Ceiling t p :: Type) x

data Ceiling' t p Source #

ceiling function where you need to provide the type 't' of the result

>>> pz @(Ceiling Int Id) (23 % 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.Prelude

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.Prelude

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

data Floor (t :: Type) p Source #

Instances
P (FloorT t p) x => P (Floor t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Floor t p :: Type) x

data Floor' t p Source #

floor function where you need to provide the type 't' of the result

>>> pz @(Floor Int Id) (23 % 5)
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.Prelude

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.Prelude

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

data Even Source #

similar to even

>>> pz @(Map Even Id) [9,-4,12,1,2,3]
PresentT [False,True,True,False,True,False]
>>> pz @(Map '(Even,Odd) Id) [9,-4,12,1,2,3]
PresentT [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]
Instances
P EvenT x => P Even x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Even x :: Type Source #

Methods

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

type PP Even x Source # 
Instance details

Defined in Predicate.Prelude

type PP Even x = Bool

data Odd Source #

Instances
P OddT x => P Odd x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Odd x :: Type Source #

Methods

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

type PP Odd x Source # 
Instance details

Defined in Predicate.Prelude

type PP Odd x = Bool

data Div p q Source #

similar to div

>>> pz @(Div (Fst Id) (Snd Id)) (10,4)
PresentT 2
>>> pz @(Div (Fst Id) (Snd Id)) (10,0)
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.Prelude

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.Prelude

type PP (Div p q :: Type) a = PP p a

data Mod p q Source #

similar to mod

>>> pz @(Mod (Fst Id) (Snd Id)) (10,3)
PresentT 1
>>> pz @(Mod (Fst Id) (Snd Id)) (10,0)
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.Prelude

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.Prelude

type PP (Mod p q :: Type) a = PP p a

data DivMod p q Source #

similar to divMod

>>> pz @(DivMod (Fst Id) (Snd Id)) (10,3)
PresentT (3,1)
>>> pz @(DivMod (Fst Id) (Snd Id)) (10,-3)
PresentT (-4,-2)
>>> pz @(DivMod (Fst Id) (Snd Id)) (-10,3)
PresentT (-4,2)
>>> pz @(DivMod (Fst Id) (Snd Id)) (-10,-3)
PresentT (3,-1)
>>> pz @(DivMod (Fst Id) (Snd Id)) (10,0)
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.Prelude

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.Prelude

type PP (DivMod p q :: Type) a = (PP p a, PP p a)

data QuotRem p q Source #

similar to quotRem

>>> pz @(QuotRem (Fst Id) (Snd Id)) (10,3)
PresentT (3,1)
>>> pz @(QuotRem (Fst Id) (Snd Id)) (10,-3)
PresentT (-3,1)
>>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,-3)
PresentT (3,-1)
>>> pz @(QuotRem (Fst Id) (Snd Id)) (-10,3)
PresentT (-3,-1)
>>> pz @(QuotRem (Fst Id) (Snd Id)) (10,0)
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.Prelude

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.Prelude

type PP (QuotRem p q :: Type) a = (PP p a, PP p a)

data Quot p q Source #

Instances
P (QuotT p q) x => P (Quot p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Quot p q :: Type) x

data Rem p q Source #

Instances
P (RemT p q) x => P (Rem p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Rem p q :: Type) x

data LogBase p q Source #

similar to logBase

>>> pz @(Fst Id `LogBase` Snd Id >> Truncate Int Id) (10,12345)
PresentT 4
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP q a), Floating (PP q a), Ord (PP p a)) => P (LogBase p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (LogBase p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (LogBase p q :: Type) a = PP p a

data p ^ q infixr 8 Source #

similar to 'GHC.Real.(^)'

>>> pz @(Fst Id ^ Snd Id) (10,4)
PresentT 10000
Instances
(P p a, P q a, Show (PP p a), Show (PP q a), Num (PP p a), Integral (PP q a)) => P (p ^ q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p ^ q :: Type) a = PP p a

data p ** q infixr 8 Source #

similar to 'GHC.Float.(**)'

>>> pz @(Fst Id ** Snd Id) (10,4)
PresentT 10000.0
Instances
(PP p a ~ PP q a, P p a, P q a, Show (PP p a), Floating (PP p a), Ord (PP q a)) => P (p ** q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p ** q :: Type) a = PP p a

rational numbers

data p % q infixl 8 Source #

creates a Rational value

>>> pz @(Id < 21 % 5) (-3.1)
TrueT
>>> pz @(Id < 21 % 5) 4.5
FalseT
>>> pz @(Fst Id % Snd Id) (13,2)
PresentT (13 % 2)
>>> pz @(13 % Id) 0
FailT "(%) zero denominator"
>>> pz @(4 % 3 + 5 % 7) "asfd"
PresentT (43 % 21)
>>> pz @(4 -% 7 * 5 -% 3) "asfd"
PresentT (20 % 21)
>>> pz @(Negate (14 % 3)) ()
PresentT ((-14) % 3)
>>> pz @(14 % 3) ()
PresentT (14 % 3)
>>> pz @(Negate (14 % 3) ==! FromIntegral _ (Negate 5)) ()
PresentT GT
>>> pz @(14 -% 3 ==! 5 -% 1) "aa"
PresentT GT
>>> pz @(Negate (14 % 3) ==! Negate 5 % 2) ()
PresentT LT
>>> pz @(14 -% 3 * 5 -% 1) ()
PresentT (70 % 3)
>>> pz @(14 % 3 ==! 5 % 1) ()
PresentT LT
>>> pz @(15 % 3 / 4 % 2) ()
PresentT (5 % 2)
Instances
(Integral (PP p x), Integral (PP q x), Eq (PP q x), P p x, P q x, Show (PP p x), Show (PP q x)) => P (p % q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p % q :: Type) x = Rational

data p -% q infixl 8 Source #

Instances
P (NegateRatioT p q) x => P (p -% q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p -% q :: Type) x

data ToRational p Source #

toRational function

>>> pz @(ToRational Id) 23.5
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.Prelude

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.Prelude

type PP (ToRational p :: Type) x = Rational

data FromRational (t :: Type) p Source #

Instances
P (FromRationalT t p) x => P (FromRational t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FromRational t p :: Type) x

data FromRational' t r Source #

fromRational function where you need to provide the type 't' of the result

>>> pz @(FromRational Rational Id) 23.5
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.Prelude

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.Prelude

type PP (FromRational' t r :: Type) a = PP t a

proxy expressions

data MkProxy Source #

converts a value to a Proxy: the same as '\'Proxy'

>>> pz @MkProxy 'x'
PresentT Proxy
Instances
Show a => P MkProxy a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP MkProxy a = Proxy a

data ProxyT (t :: Type) Source #

Instances
P (ProxyT t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ProxyT t) x :: Type Source #

Methods

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

type PP (ProxyT t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (ProxyT t :: Type) x

data ProxyT' t Source #

Instances
P (ProxyT' t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ProxyT' t :: Type) x = Proxy (PP t x)

data Unproxy Source #

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

Defined in Predicate.Prelude

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.Prelude

type PP Unproxy (Proxy a) = a

read / show expressions

data ShowP p Source #

similar to show

>>> pz @(ShowP Id) [4,8,3,9]
PresentT "[4,8,3,9]"
>>> pz @(ShowP Id) 'x'
PresentT "'x'"
>>> pz @(ShowP (42 -% 10)) 'x'
PresentT "(-21) % 5"
Instances
(Show (PP p x), P p x) => P (ShowP p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ShowP p :: Type) x = String

data ReadP (t :: Type) p Source #

Instances
P (ReadPT t p) x => P (ReadP t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (ReadP t p :: Type) x

data ReadP' t p Source #

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

>>> pz @(ReadP Rational Id) "4 % 5"
PresentT (4 % 5)
>>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2018-10-12"
TrueT
>>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2016-10-12"
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.Prelude

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.Prelude

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

data ReadQ (t :: Type) p Source #

Instances
P (ReadQT t p) x => P (ReadQ t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReadQ t p :: Type) x

data ReadQ' t p Source #

emulates ReadP

Instances
P (ReadQT' t p) x => P (ReadQ' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReadQ' t p :: Type) x

data ReadMaybe (t :: Type) p Source #

Instances
P (ReadMaybeT t p) x => P (ReadMaybe t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReadMaybe t p :: Type) x

data ReadMaybe' t p Source #

Read but returns the Maybe of the value and any remaining unparsed string

>>> pz @(ReadMaybe Int Id) "123x"
PresentT (Just (123,"x"))
>>> pz @(ReadMaybe Int Id) "123"
PresentT (Just (123,""))
>>> pz @(ReadMaybe Int Id) "x123"
PresentT Nothing
Instances
(P p x, PP p x ~ String, Typeable (PP t x), Show (PP t x), Read (PP t x)) => P (ReadMaybe' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ReadMaybe' t p :: Type) x = Maybe (PP t x, String)

data ReadBase (t :: Type) (n :: Nat) p Source #

Instances
P (ReadBaseT t n p) x => P (ReadBase t n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (ReadBase t n p :: Type) x

data ReadBase' t (n :: Nat) p Source #

Read a number using base 2 through a maximum of 36

>>> pz @(ReadBase Int 16 Id) "00feD"
PresentT 4077
>>> pz @(ReadBase Int 16 Id) "-ff"
PresentT (-255)
>>> pz @(ReadBase Int 2 Id) "10010011"
PresentT 147
>>> pz @(ReadBase Int 8 Id) "Abff"
FailT "invalid base 8"
>>> pl @(ReadBase Int 16 Id >> GuardSimple (Id > 0xffff) >> ShowBase 16 Id) "12344"
Present "12344" ((>>) "12344" | {ShowBase(16) 12344 | 74564})
PresentT "12344"
>>> :set -XBinaryLiterals
>>> pz @(ReadBase Int 16 Id >> GuardSimple (Id > 0b10011111) >> ShowBase 16 Id) "7f"
FailT "(127 > 159)"
Instances
(Typeable (PP t x), ZwischenT 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.Prelude

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.Prelude

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

data ShowBase (n :: Nat) p Source #

Display a number at base 2 to 36, similar to showIntAtBase but supports signed numbers

>>> pz @(ShowBase 16 Id) 4077
PresentT "fed"
>>> pz @(ShowBase 16 Id) (-255)
PresentT "-ff"
>>> pz @(ShowBase 2 Id) 147
PresentT "10010011"
>>> pz @(ShowBase 2 (Negate 147)) "whatever"
PresentT "-10010011"
Instances
(PP p x ~ a, P p x, Show a, 2 <= n, n <= 36, KnownNat n, Integral a) => P (ShowBase n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ShowBase n p :: Type) x = String

aeson expressions

data ParseJson' t p Source #

parse json data

>>> pl @(ParseJson (Int,String) Id) "[10,\"abc\"]"
Present (10,"abc") (ParseJson (Int,[Char]) (10,"abc"))
PresentT (10,"abc")
>>> pl @(ParseJson (Int,String) Id) "[10,\"abc\",99]"
Error ParseJson (Int,[Char])([10,"abc",...) Error in $ (ParseJson (Int,[Char]) failed Error in $: cannot unpack array of length 3 into a tuple of length 2 | [10,"abc",99])
FailT "ParseJson (Int,[Char])([10,\"abc\",...) Error in $"
>>> pl @(ParseJson (Int,Bool) (FromString _ Id)) ("[1,true]" :: String)
Present (1,True) (ParseJson (Int,Bool) (1,True))
PresentT (1,True)
>>> pl @(ParseJson (Int,Bool) Id) (A.encode (1,True))
Present (1,True) (ParseJson (Int,Bool) (1,True))
PresentT (1,True)
>>> pl @(ParseJson () Id) "[1,true]"
Error ParseJson ()([1,true]) Error in $ (ParseJson () failed Error in $: parsing () failed, expected an empty array | [1,true])
FailT "ParseJson ()([1,true]) Error in $"
Instances
(P p x, PP p x ~ ByteString, Typeable (PP t x), Show (PP t x), FromJSON (PP t x)) => P (ParseJson' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

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

data ParseJson (t :: Type) p Source #

Instances
P (ParseJsonT t p) x => P (ParseJson t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ParseJson t p :: Type) x

data EncodeJson p Source #

encode json

>>> pl @(EncodeJson Id) (10,"def")
Present "[10,\"def\"]" (EncodeJson [10,"def"])
PresentT "[10,\"def\"]"
>>> pl @(EncodeJson Id >> ParseJson (Int,Bool) Id) (1,True)
Present (1,True) ((>>) (1,True) | {ParseJson (Int,Bool) (1,True)})
PresentT (1,True)
Instances
(ToJSON (PP p x), P p x) => P (EncodeJson p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (EncodeJson p :: Type) x = ByteString

data EncodeJsonFile p q Source #

encode a json file

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (EncodeJsonFile p q :: Type) x = ()

data ParseJsonFile' t p Source #

parse a json file

>>> pz @(ParseJsonFile [A.Value] "test1.json" >> Id !! 2) ()
PresentT (Object (fromList [("lastName",String "Doe"),("age",Number 45.0),("firstName",String "John"),("likesPizza",Bool False)]))
Instances
(P p x, PP p x ~ String, Typeable (PP t x), Show (PP t x), FromJSON (PP t x)) => P (ParseJsonFile' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

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

data ParseJsonFile (t :: Type) p Source #

Instances
P (ParseJsonFileT t p) x => P (ParseJsonFile t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ParseJsonFile t p :: Type) x

arrow expressions

data p &&& q infixr 3 Source #

similar to &&&

Instances
P (WAmpT p q) x => P (p &&& q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p &&& q :: Type) x

data p *** q infixr 3 Source #

similar to ***

>>> pz @(Pred Id *** ShowP Id) (13, True)
PresentT (12,"True")
>>> pl @(FlipT (***) Len (Id * 12)) (99,"cdef")
Present (1188,4) ((***) (1188,4) | (99,"cdef"))
PresentT (1188,4)
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.Prelude

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.Prelude

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

data First p Source #

Instances
P (FirstT p) x => P (First p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (First p :: Type) x

data Second q Source #

Instances
P (SecondT q) x => P (Second q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Second q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (Second q :: Type) x

data p ||| q infixr 2 Source #

similar |||

>>> pz @(Pred Id ||| Id) (Left 13)
PresentT 12
>>> pz @(ShowP Id ||| Id) (Right "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.Prelude

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.Prelude

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

data p +++ q infixr 2 Source #

similar +++

>>> pz @(Pred Id +++ Id) (Left 13)
PresentT (Left 12)
>>> pz @(ShowP Id +++ Reverse) (Right "hello")
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.Prelude

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.Prelude

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

compare expressions

data p > q infix 4 Source #

Instances
P (Cmp CGt p q) x => P (p > q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p > q :: Type) x = Bool

data p >= q infix 4 Source #

Instances
P (Cmp CGe p q) x => P (p >= q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p >= q :: Type) x = Bool

data p == q infix 4 Source #

Instances
P (Cmp CEq p q) x => P (p == q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p == q :: Type) x = Bool

data p /= q infix 4 Source #

Instances
P (Cmp CNe p q) x => P (p /= q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p /= q :: Type) x = Bool

data p <= q infix 4 Source #

Instances
P (Cmp CLe p q) x => P (p <= q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <= q :: Type) x = Bool

data p < q infix 4 Source #

Instances
P (Cmp CLt p q) x => P (p < q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p < q :: Type) x = Bool

data p >~ q infix 4 Source #

Instances
P (CmpI CGt p q) x => P (p >~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p >~ q :: Type) x = Bool

data p >=~ q infix 4 Source #

Instances
P (CmpI CGe p q) x => P (p >=~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p >=~ q :: Type) x = Bool

data p ==~ q infix 4 Source #

Instances
P (CmpI CEq p q) x => P (p ==~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p ==~ q :: Type) x = Bool

data p /=~ q infix 4 Source #

Instances
P (CmpI CNe p q) x => P (p /=~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p /=~ q :: Type) x = Bool

data p <=~ q infix 4 Source #

Instances
P (CmpI CLe p q) x => P (p <=~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <=~ q :: Type) x = Bool

data p <~ q infix 4 Source #

Instances
P (CmpI CLt p q) x => P (p <~ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <~ q :: Type) x = Bool

type Gt n = I > n Source #

type Ge n = I >= n Source #

type Same n = I == n Source #

type Le n = I <= n Source #

type Lt n = I < n Source #

type Ne n = I /= n Source #

data p ==! q infix 4 Source #

similar to compare

>>> pz @(Fst Id ==! Snd Id) (10,9)
PresentT GT
>>> pz @(14 % 3 ==! Fst Id -% Snd Id) (-10,7)
PresentT GT
>>> pz @(Fst Id ==! Snd Id) (10,11)
PresentT LT
>>> pz @(Snd Id ==! (Fst Id >> Snd Id >> Head Id)) (('x',[10,12,13]),10)
PresentT EQ
>>> pz @(Snd Id ==! Head (Snd (Fst Id))) (('x',[10,12,13]),10)
PresentT EQ
Instances
(Ord (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.Prelude

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.Prelude

type PP (p ==! q :: Type) a = Ordering

type OrdP p q = p ==! q Source #

data OrdA' p q Source #

Instances
P (OrdAT' p q) x => P (OrdA' p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (OrdA' p q :: Type) x

data OrdA p Source #

Instances
P (OrdA' p p) x => P (OrdA p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (OrdA p :: Type) x = PP (OrdA' p p) x

type OrdI p q = p ===~ q Source #

compare two strings ignoring case

>>> pz @(Fst Id ===~ Snd Id) ("abC","aBc")
PresentT EQ
>>> pz @(Fst Id ===~ Snd Id) ("abC","DaBc")
PresentT LT

data p ===~ q infix 4 Source #

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

Defined in Predicate.Prelude

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.Prelude

type PP (p ===~ q :: Type) a = Ordering

data Cmp (o :: OrderingP) p q Source #

compare two values using the given ordering 'o'

>>> pl @(Lt 4) 123
False (123 < 4)
FalseT
>>> pl @(Lt 4) 1
True (1 < 4)
TrueT
>>> pl @(Negate 7 <..> 20) (-4)
True (-7 <= -4 <= 20)
TrueT
>>> pl @(Negate 7 <..> 20) 21
False (21 <= 20)
FalseT
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.Prelude

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.Prelude

type PP (Cmp o p q :: Type) a = Bool

data CmpI (o :: OrderingP) p q Source #

compare two strings ignoring case using the given ordering 'o'

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.Prelude

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.Prelude

type PP (CmpI o p q :: Type) a = Bool

enum expressions

data Succ p Source #

unbounded succ function

>>> pz @(Succ Id) 13
PresentT 14
>>> pz @(Succ Id) LT
PresentT EQ
>>> pz @(Succ Id) GT
FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument"
Instances
(Show a, Enum a, PP p x ~ a, P p x) => P (Succ p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Succ p :: Type) x = PP p x

data Pred p Source #

unbounded pred function

>>> pz @(Pred Id) 13
PresentT 12
>>> pz @(Pred Id) LT
FailT "Pred IO e=Prelude.Enum.Ordering.pred: bad argument"
Instances
(Show a, Enum a, PP p x ~ a, P p x) => P (Pred p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Pred p :: Type) x = PP p x

data FromEnum p Source #

fromEnum function

>>> pz @(FromEnum Id) 'x'
PresentT 120
Instances
(Show a, Enum a, PP p x ~ a, P p x) => P (FromEnum p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FromEnum p :: Type) x = Int

data ToEnum (t :: Type) p Source #

Instances
P (ToEnumT t p) x => P (ToEnum t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToEnum t p :: Type) x

data ToEnum' t p Source #

unsafe toEnum function

>>> pz @(ToEnum Char Id) 120
PresentT 'x'
Instances
(PP p x ~ a, P p x, Show a, Enum (PP t x), Show (PP t x), Integral a) => P (ToEnum' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

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

data EnumFromTo p q Source #

similar to enumFromTo

>>> pz @(EnumFromTo 2 5) ()
PresentT [2,3,4,5]
>>> pz @(EnumFromTo 'LT 'GT) ()
PresentT [LT,EQ,GT]
>>> pz @(EnumFromTo 'GT 'LT) ()
PresentT []
>>> pz @(EnumFromTo (Pred Id) (Succ Id)) (SG.Max 10)
PresentT [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]
>>> pz @(EnumFromTo 1 20 >> Map '(Id, (If (Id `Mod` 3 == 0) "Fizz" "" <> If (Id `Mod` 5 == 0) "Buzz" "" )) Id) 123
PresentT [(1,""),(2,""),(3,"Fizz"),(4,""),(5,"Buzz"),(6,"Fizz"),(7,""),(8,""),(9,"Fizz"),(10,"Buzz"),(11,""),(12,"Fizz"),(13,""),(14,""),(15,"FizzBuzz"),(16,""),(17,""),(18,"Fizz"),(19,""),(20,"Buzz")]
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.Prelude

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.Prelude

type PP (EnumFromTo p q :: Type) x = [PP p x]

data EnumFromThenTo p q r Source #

similar to enumFromThenTo

>>> pz @(EnumFromThenTo (ToEnum Day 10) (ToEnum Day 20) (ToEnum Day 70)) ()
PresentT [1858-11-27,1858-12-07,1858-12-17,1858-12-27,1859-01-06,1859-01-16,1859-01-26]
>>> pz @(EnumFromThenTo (ReadP Day "2020-01-12") (ReadP Day "2020-02-12") (ReadP Day "2020-08-12")) ()
PresentT [2020-01-12,2020-02-12,2020-03-14,2020-04-14,2020-05-15,2020-06-15,2020-07-16]
Instances
(P p x, P q x, P r x, PP p x ~ a, Show a, PP q x ~ a, PP r x ~ a, Enum a) => P (EnumFromThenTo p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (EnumFromThenTo p q r :: Type) x = [PP p x]

bounded enum expressions

data SuccB p q Source #

Instances
(PP q x ~ a, P q x, P p (Proxy a), PP p (Proxy a) ~ a, Show a, Eq a, Bounded a, Enum a) => P (SuccB p q :: Type) x Source #

bounded succ function

>>> pz @(SuccB' Id) (13 :: Int)
PresentT 14
>>> pz @(SuccB' Id) LT
PresentT EQ
>>> pz @(SuccB 'LT Id) GT
PresentT LT
>>> pz @(SuccB' Id) GT
FailT "Succ bounded"
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (SuccB p q :: Type) x = PP q x

data SuccB' q Source #

Instances
P (SuccBT' q) x => P (SuccB' q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (SuccB' q) x :: Type Source #

Methods

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

type PP (SuccB' q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (SuccB' q :: Type) x

data PredB p q Source #

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (PredB p q :: Type) x = PP q x

data PredB' q Source #

bounded pred function

>>> pz @(PredB' Id) (13 :: Int)
PresentT 12
>>> pz @(PredB' Id) LT
FailT "Pred bounded"
Instances
P (PredBT' q) x => P (PredB' q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (PredB' q) x :: Type Source #

Methods

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

type PP (PredB' q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (PredB' q :: Type) x

data ToEnumBDef (t :: Type) def Source #

Instances
P (ToEnumBDefT t def) x => P (ToEnumBDef t def :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ToEnumBDef t def) x :: Type Source #

Methods

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

type PP (ToEnumBDef t def :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (ToEnumBDef t def :: Type) x

data ToEnumBDef' t def Source #

bounded toEnum function

>>> pz @(ToEnumBDef Ordering LT) 2
PresentT GT
>>> pz @(ToEnumBDef Ordering LT) 6
PresentT LT
>>> pz @(ToEnumBFail Ordering) 6
FailT "ToEnum bounded"
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 (ToEnumBDef' t def :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (ToEnumBDef' t def :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (ToEnumBDef' t def :: Type) a = PP t a

data ToEnumBFail (t :: Type) Source #

Instances
P (ToEnumBFailT t) x => P (ToEnumBFail t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ToEnumBFail t) x :: Type Source #

Methods

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

type PP (ToEnumBFail t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (ToEnumBFail t :: Type) x

wrap / unwrap expressions

data Unwrap p Source #

unwraps a value (see _Wrapped')

>>> pz @(Unwrap Id) (SG.Sum (-13))
PresentT (-13)
Instances
(PP p x ~ s, P p x, Show s, Show (Unwrapped s), Wrapped s) => P (Unwrap p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Unwrap p :: Type) x = Unwrapped (PP p x)

data Wrap (t :: Type) p Source #

Instances
P (WrapT t p) x => P (Wrap t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Wrap t p :: Type) x

data Wrap' t p Source #

wraps a value (see _Wrapped' and _Unwrapped')

>>> :m + Data.List.NonEmpty
>>> pz @(Wrap (SG.Sum _) Id) (-13)
PresentT (Sum {getSum = -13})
>>> pz @(Wrap SG.Any (Ge 4)) 13
PresentT (Any {getAny = True})
>>> pz @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"
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.Prelude

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.Prelude

type PP (Wrap' s p :: Type) x = PP s x

data Coerce (t :: k) Source #

similar to coerce

>>> pz @(Coerce (SG.Sum Integer)) (Identity (-13))
PresentT (Sum {getSum = -13})
Instances
(Show a, Show t, Coercible t a) => P (Coerce t :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Coerce t :: Type) a = t

data Coerce2 (t :: k) Source #

see Coerce: coerce over a functor

>>> pz @(Coerce2 (SG.Sum Integer)) [Identity (-13), Identity 4, Identity 99]
PresentT [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]
>>> pz @(Coerce2 (SG.Sum Integer)) (Just (Identity (-13)))
PresentT (Just (Sum {getSum = -13}))
>>> pz @(Coerce2 (SG.Sum Int)) (Nothing @(Identity Int))
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.Prelude

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.Prelude

type PP (Coerce2 t :: Type) (f a) = f t

list / foldable expressions

data Map p q Source #

similar to map

>>> pz @(Map (Pred Id) Id) [1..5]
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.Prelude

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.Prelude

type PP (Map p q :: Type) x

data Concat p Source #

similar to concat

>>> pz @(Concat Id) ["abc","D","eF","","G"]
PresentT "abcDeFG"
>>> pz @(Concat (Snd Id)) ('x',["abc","D","eF","","G"])
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.Prelude

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.Prelude

type PP (Concat p :: Type) x

data ConcatMap p q Source #

Instances
P (ConcatMapT p q) x => P (ConcatMap p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ConcatMap p q :: Type) x

data Partition p q Source #

similar to partition

>>> pz @(Partition (Ge 3) Id) [10,4,1,7,3,1,3,5]
PresentT ([10,4,7,3,3,5],[1,1])
>>> pz @(Partition (Prime Id) Id) [10,4,1,7,3,1,3,5]
PresentT ([7,3,3,5],[10,4,1,1])
>>> pz @(Partition (Ge 300) Id) [10,4,1,7,3,1,3,5]
PresentT ([],[10,4,1,7,3,1,3,5])
>>> pz @(Partition (Id < 300) Id) [10,4,1,7,3,1,3,5]
PresentT ([10,4,1,7,3,1,3,5],[])
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.Prelude

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.Prelude

type PP (Partition p q :: Type) a = (PP q a, PP q a)

data GroupOn t p q Source #

groups values based on a function

>>> pl @(GroupOn Ordering (Case (Failt _ "asdf") '[Id < 2, Id == 2, Id > 2] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]
Present fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] (GroupOn fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] | s=[-4,2,5,6,7,1,2,3,4])
PresentT (fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])])
>>> pl @(GroupOn Ordering (Case (Failt _ "xyzxyzxyzzyyysyfsyfydf") '[Id < 2, Id == 2, Id > 3] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]
Error xyzxyzxyzzyyysyfsyfydf (GroupOn(i=7, a=3) excnt=1)
FailT "xyzxyzxyzzyyysyfsyfydf"
Instances
(P p x, Ord t, Show x, Show t, PP q a ~ [x], PP p x ~ t, P q a) => P (GroupOn t p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (GroupOn t p q :: Type) a = Map t (PP q a)

data Filter p q Source #

Instances
P (FilterT p q) x => P (Filter p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Filter p q :: Type) x

data Break p q Source #

similar to break

>>> pz @(Break (Ge 3) Id) [10,4,1,7,3,1,3,5]
PresentT ([],[10,4,1,7,3,1,3,5])
>>> pz @(Break (Lt 3) Id) [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.Prelude

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.Prelude

type PP (Break p q :: Type) a = (PP q a, PP q a)

data Span p q Source #

Instances
P (SpanT p q) x => P (Span p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Span p q :: Type) x

data Intercalate p q Source #

intercalate two lists

>>> pz @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()
PresentT ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]
>>> pz @(Intercalate '[W 99,Negate 98] Id) [1..5]
PresentT [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]
>>> pz @(Intercalate '[99,100] Id) [1..5]
PresentT [1,99,100,2,99,100,3,99,100,4,99,100,5]
Instances
(PP p x ~ [a], PP q x ~ PP p x, P p x, P q x, Show a) => P (Intercalate p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Intercalate p q :: Type) x = PP p x

data Elem p q Source #

elem function

>>> pz @(Elem (Fst Id) (Snd Id)) ('x',"abcdxy")
TrueT
>>> pz @(Elem (Fst Id) (Snd Id)) ('z',"abcdxy")
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.Prelude

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.Prelude

type PP (Elem p q :: Type) a = Bool

data Inits Source #

similar to inits

>>> pz @Inits [4,8,3,9]
PresentT [[],[4],[4,8],[4,8,3],[4,8,3,9]]
>>> pz @Inits []
PresentT [[]]
Instances
([a] ~ x, Show a) => P Inits x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Inits x :: Type Source #

Methods

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

type PP Inits x Source # 
Instance details

Defined in Predicate.Prelude

type PP Inits x = [x]

data Tails Source #

similar to tails

>>> pz @Tails [4,8,3,9]
PresentT [[4,8,3,9],[8,3,9],[3,9],[9],[]]
>>> pz @Tails []
PresentT [[]]
Instances
([a] ~ x, Show a) => P Tails x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Tails x :: Type Source #

Methods

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

type PP Tails x Source # 
Instance details

Defined in Predicate.Prelude

type PP Tails x = [x]

data Ones p Source #

split a list into single values

>>> pz @(Ones Id) [4,8,3,9]
PresentT [[4],[8],[3],[9]]
>>> pz @(Ones Id) []
PresentT []
Instances
(PP p x ~ [a], P p x, Show a) => P (Ones p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Ones p :: Type) x = [PP p x]

data OneP p Source #

gets the singleton value from a foldable

>>> pl @(OneP Id) [10..15]
Error OneP 6 elements (OneP expected one element)
FailT "OneP 6 elements"
>>> pl @(OneP Id) [10]
Present 10 (OneP)
PresentT 10
>>> pl @(OneP Id) []
Error OneP empty (OneP expected one element)
FailT "OneP empty"
>>> pl @(OneP Id) (Just 10)
Present 10 (OneP)
PresentT 10
>>> pl @(OneP Id) Nothing
Error OneP empty (OneP expected one element)
FailT "OneP empty"
Instances
(Foldable t, PP p x ~ t a, P p x) => P (OneP p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (OneP p :: Type) x

data Len Source #

similar to length

>>> pz @Len [10,4,5,12,3,4]
PresentT 6
>>> pz @Len []
PresentT 0
Instances
(Show a, as ~ [a]) => P Len as Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Len as = Int

data Length p Source #

similar to length for Foldable instances

>>> pz @(Length Id) (Left "aa")
PresentT 0
>>> pz @(Length Id) (Right "aa")
PresentT 1
>>> pz @(Length (Right' Id)) (Right "abcd")
PresentT 4
>>> pz @(Length (Thd (Snd Id))) (True,(23,'x',[10,9,1,3,4,2]))
PresentT 6
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.Prelude

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.Prelude

type PP (Length p :: Type) x = Int

data PadL n p q Source #

Instances
P (PadLT n p q) x => P (PadL n p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (PadL n p q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (PadL n p q :: Type) x

data PadR n p q Source #

Instances
P (PadRT n p q) x => P (PadR n p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (PadR n p q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (PadR n p q :: Type) x

data Cycle n p Source #

similar to cycle but for a fixed number 'n'

>>> pz @(Cycle 5 Id) [1,2]
PresentT [1,2,1,2,1]
Instances
(Show a, Show (t a), PP p x ~ t a, P p x, Integral (PP n x), P n x, Foldable t) => P (Cycle n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Cycle n p :: Type) x

data SplitAts ns p Source #

split a list 'p' into parts using the lengths in the type level list 'ns'

>>> pz @(SplitAts '[2,3,1,1] Id) "hello world"
PresentT ["he","llo"," ","w","orld"]
>>> pz @(SplitAts '[2] Id) "hello world"
PresentT ["he","llo world"]
>>> pz @(SplitAts '[10,1,1,5] Id) "hello world"
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.Prelude

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.Prelude

type PP (SplitAts ns p :: Type) x = [PP p x]

data SplitAt n p Source #

similar to splitAt

>>> pz @(SplitAt 4 Id) "hello world"
PresentT ("hell","o world")
>>> pz @(SplitAt 20 Id) "hello world"
PresentT ("hello world","")
>>> pz @(SplitAt 0 Id) "hello world"
PresentT ("","hello world")
>>> pz @(SplitAt (Snd Id) (Fst Id)) ("hello world",4)
PresentT ("hell","o world")
>>> pz @(SplitAt (Negate 2) Id) "hello world"
PresentT ("hello wor","ld")
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.Prelude

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.Prelude

type PP (SplitAt n p :: Type) a = (PP p a, PP p a)

data ChunksOf n p Source #

splits a list pointed to by 'p' into lists of size 'n'

>>> pz @(ChunksOf 2 Id) "abcdef"
PresentT ["ab","cd","ef"]
>>> pz @(ChunksOf 2 Id) "abcdefg"
PresentT ["ab","cd","ef","g"]
>>> pz @(ChunksOf 2 Id) ""
PresentT []
>>> pz @(ChunksOf 2 Id) "a"
PresentT ["a"]
Instances
(PP p a ~ [b], P n a, P p a, Show b, Integral (PP n a)) => P (ChunksOf n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (ChunksOf n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (ChunksOf n p :: Type) a = [PP p a]

data Rotate n p Source #

Instances
P (RotateT n p) x => P (Rotate n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Rotate n p :: Type) x

data Take n p Source #

Instances
P (TakeT n p) x => P (Take n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Take n p :: Type) x

data Drop n p Source #

Instances
P (DropT n p) x => P (Drop n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Drop n p :: Type) x

data Min Source #

similar to minimum

>>> pz @Min [10,4,5,12,3,4]
PresentT 3
>>> pz @Min []
FailT "empty list"
Instances
(Ord a, Show a) => P Min [a] Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Min [a] = a

data Max Source #

similar to maximum

>>> pz @Max [10,4,5,12,3,4]
PresentT 12
>>> pz @Max []
FailT "empty list"
Instances
(Ord a, Show a) => P Max [a] Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Max [a] = a

data Sum Source #

similar to sum

>>> pz @Sum [10,4,5,12,3,4]
PresentT 38
>>> pz @Sum []
PresentT 0
Instances
(Num a, Show a) => P Sum [a] Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Sum [a] :: Type Source #

Methods

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

type PP Sum [a] Source # 
Instance details

Defined in Predicate.Prelude

type PP Sum [a] = a

data Product Source #

similar to product

>>> pz @Product [10,4,5,12,3,4]
PresentT 28800
>>> pz @Product []
PresentT 1
Instances
(Num a, Show a) => P Product [a] Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Product [a] :: Type Source #

Methods

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

type PP Product [a] Source # 
Instance details

Defined in Predicate.Prelude

type PP Product [a] = a

data IsEmpty Source #

similar to null using AsEmpty

>>> pz @IsEmpty [1,2,3,4]
FalseT
>>> pz @IsEmpty []
TrueT
>>> pz @IsEmpty LT
FalseT
>>> pz @IsEmpty EQ
TrueT
Instances
(Show as, AsEmpty as) => P IsEmpty as Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP IsEmpty as = Bool

data Null Source #

similar to null using Foldable

>>> pz @Null [1,2,3,4]
FalseT
>>> pz @Null []
TrueT
>>> pz @Null Nothing
TrueT
Instances
P NullT a => P Null a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Null a :: Type Source #

Methods

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

type PP Null a Source # 
Instance details

Defined in Predicate.Prelude

type PP Null a = Bool

data Null' p Source #

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

Defined in Predicate.Prelude

Associated Types

type PP (Null' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (Null' p :: Type) x = Bool

data ToList Source #

similar to toList

>>> pz @ToList ("aBc" :: String)
PresentT "aBc"
>>> pz @ToList (Just 14)
PresentT [14]
>>> pz @ToList Nothing
PresentT []
>>> pz @ToList (Left "xx")
PresentT []
>>> pz @ToList (These 12 "xx")
PresentT ["xx"]
Instances
(Show (t a), Foldable t, Show a) => P ToList (t a) Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ToList (t a) = [a]

data ToList' p Source #

similar to toList

>>> pz @(ToList' Id) ("aBc" :: String)
PresentT "aBc"
>>> pz @(ToList' Id) (Just 14)
PresentT [14]
>>> pz @(ToList' Id) Nothing
PresentT []
>>> pz @(ToList' Id) (Left "xx")
PresentT []
>>> pz @(ToList' Id) (These 12 "xx")
PresentT ["xx"]
Instances
(PP p x ~ t a, P p x, Show (t a), Foldable t, Show a) => P (ToList' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ToList' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (ToList' p :: Type) x

data IToList (t :: Type) p Source #

Instances
P (IToListT t p) x => P (IToList t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (IToList t p :: Type) x

data IToList' t p Source #

similar to itoList

>>> pz @(IToList _ Id) ("aBc" :: String)
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.Prelude

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.Prelude

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

data FromList (t :: Type) Source #

invokes fromList

>>> import qualified Data.Set as Set
>>> run @('OMsg "Fred" ':# 'ODebug 'DLite ':# 'ONoColor 'True) @(FromList (Set.Set Int) << '[2,1,5,5,2,5,2]) ()
Fred >>> Present fromList [1,2,5] ((>>) fromList [1,2,5] | {FromList fromList [1,2,5]})
PresentT (fromList [1,2,5])
Instances
(a ~ Item t, Show t, IsList t, [a] ~ x) => P (FromList t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (FromList t) x :: Type Source #

Methods

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

type PP (FromList t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (FromList t :: Type) x = t

data EmptyList (t :: Type) Source #

Instances
P (EmptyList t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (EmptyList t) x :: Type Source #

Methods

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

type PP (EmptyList t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (EmptyList t :: Type) x

data EmptyList' t Source #

creates an empty list of the given type

>>> pz @(Id :+ EmptyList _) 99
PresentT [99]
Instances
P (EmptyList' t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (EmptyList' t) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (EmptyList' t :: Type) x = [PP t x]

data Singleton p Source #

creates a singleton from a value

>>> pz @(Singleton (Char1 "aBc")) ()
PresentT "a"
>>> pz @(Singleton Id) False
PresentT [False]
>>> pz @(Singleton (Snd Id)) (False,"hello")
PresentT ["hello"]
Instances
P p x => P (Singleton p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Singleton p :: Type) x = [PP p x]

data Reverse Source #

similar to reverse

>>> pz @Reverse [1,2,4]
PresentT [4,2,1]
>>> pz @Reverse "AbcDeF"
PresentT "FeDcbA"
Instances
(Show a, as ~ [a]) => P Reverse as Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Reverse as = as

data ReverseL Source #

reverses using reversing

>>> pz @ReverseL (T.pack "AbcDeF")
PresentT "FeDcbA"
>>> pz @ReverseL ("AbcDeF" :: String)
PresentT "FeDcbA"
Instances
(Show t, Reversing t) => P ReverseL t Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ReverseL t = t

data SortBy p q Source #

sort a list

>>> pz @(SortOn (Fst Id) Id) [(10,"abc"), (3,"def"), (4,"gg"), (10,"xyz"), (1,"z")]
PresentT [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]
>>> pz @(SortBy (OrdP (Snd Id) (Fst Id)) Id) [(10,"ab"),(4,"x"),(20,"bbb")]
PresentT [(20,"bbb"),(10,"ab"),(4,"x")]
>>> pz @(SortBy 'LT Id) [1,5,2,4,7,0]
PresentT [1,5,2,4,7,0]
>>> pz @(SortBy 'GT Id) [1,5,2,4,7,0]
PresentT [0,7,4,2,5,1]
>>> pz @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Fst Id) ==! Snd (Snd Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
PresentT [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]
>>> pz @(SortBy ((Fst (Fst Id) ==! Fst (Snd Id)) <> (Snd (Snd Id) ==! Snd (Fst Id))) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]
PresentT [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]
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.Prelude

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.Prelude

type PP (SortBy p q :: Type) x = PP q x

data SortOn p q Source #

Instances
P (SortOnT p q) x => P (SortOn p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (SortOn p q :: Type) x

data SortOnDesc p q Source #

Instances
P (SortOnDescT p q) x => P (SortOnDesc p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (SortOnDesc p q :: Type) x

data Remove p q Source #

Instances
P (RemoveT p q) x => P (Remove p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Remove p q :: Type) x

data Keep p q Source #

Instances
P (KeepT p q) x => P (Keep p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Keep p q :: Type) x

overloaded list expressions

data ToListExt Source #

invokes toList

>>> pz @ToListExt (M.fromList [(1,'x'),(4,'y')])
PresentT [(1,'x'),(4,'y')]
>>> pz @ToListExt (T.pack "abc")
PresentT "abc"
Instances
(Show l, IsList l, Show (Item l)) => P ToListExt l Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ToListExt l = [Item l]

data FromListExt (t :: Type) Source #

invokes fromList

requires the OverloadedLists extension

>>> :set -XOverloadedLists
>>> pz @(FromListExt (M.Map _ _)) [(4,"x"),(5,"dd")]
PresentT (fromList [(4,"x"),(5,"dd")])
Instances
(Show l, IsList l, l ~ l') => P (FromListExt l' :: Type) l Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (FromListExt l' :: Type) l Source # 
Instance details

Defined in Predicate.Prelude

type PP (FromListExt l' :: Type) l = l'

maybe expressions

data MkNothing (t :: Type) Source #

Instances
P (MkNothing t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (MkNothing t) x :: Type Source #

Methods

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

type PP (MkNothing t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (MkNothing t :: Type) x

data MkNothing' t Source #

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

Defined in Predicate.Prelude

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.Prelude

type PP (MkNothing' t :: Type) a = Maybe (PP t a)

data MkJust p Source #

Just constructor

>>> pz @(MkJust Id) 44
PresentT (Just 44)
Instances
(PP p x ~ a, P p x, Show a) => P (MkJust p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MkJust p :: Type) x = Maybe (PP p x)

data IsNothing p Source #

similar to isNothing

>>> pz @(IsNothing Id) (Just 123)
FalseT
>>> pz @(IsNothing Id) Nothing
TrueT
Instances
(P p x, PP p x ~ Maybe a) => P (IsNothing p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsNothing p :: Type) x = Bool

data IsJust p Source #

similar to isJust

>>> pz @(IsJust Id) Nothing
FalseT
>>> pz @(IsJust Id) (Just 'a')
TrueT
Instances
(P p x, PP p x ~ Maybe a) => P (IsJust p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsJust p :: Type) x = Bool

data MapMaybe p q Source #

Instances
P (MapMaybeT p q) x => P (MapMaybe p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MapMaybe p q :: Type) x

data CatMaybes q Source #

similar to catMaybes

>>> pl @(CatMaybes Id) [Just 'a',Nothing,Just 'c',Just 'd',Nothing]
Present "acd" (Concat "acd" | ["a","","c","d",""])
PresentT "acd"
Instances
P (CatMaybesT q) x => P (CatMaybes q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (CatMaybes q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (CatMaybes q :: Type) x

data Just p Source #

tries to extract a from Maybe a otherwise it fails

>>> pz @(Just Id) (Just "abc")
PresentT "abc"
>>> pz @(Just Id) Nothing
FailT "Just(empty)"
Instances
(Show a, PP p x ~ Maybe a, P p x) => P (Just p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Just p :: Type) x

data JustDef p q Source #

extract the value from a Maybe otherwise use the default value

>>> pz @(JustDef (1 % 4) Id) (Just 20.4)
PresentT (102 % 5)
>>> pz @(JustDef (1 % 4) Id) Nothing
PresentT (1 % 4)
>>> pz @(JustDef (MEmptyT _) Id) (Just "xy")
PresentT "xy"
>>> pz @(JustDef (MEmptyT _) Id) Nothing
PresentT ()
>>> pz @(JustDef (MEmptyT (SG.Sum _)) Id) Nothing
PresentT (Sum {getSum = 0})
Instances
(PP p x ~ a, PP q x ~ Maybe a, P p x, P q x) => P (JustDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (JustDef p q :: Type) x

data JustFail p q Source #

extract the value from a Maybe or fail

>>> pz @(JustFail "nope" Id) (Just 99)
PresentT 99
>>> pz @(JustFail "nope" Id) Nothing
FailT "nope"
>>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Nothing, 123)
FailT "oops=123"
>>> pz @(JustFail (PrintF "oops=%d" (Snd Id)) (Fst Id)) (Just 'x', 123)
PresentT 'x'
Instances
(PP p x ~ String, PP q x ~ Maybe a, P p x, P q x) => P (JustFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (JustFail p q :: Type) x

data MaybeIn p q Source #

similar to maybe

provides a Proxy to the result of 'q' but does not provide the surrounding context

>>> pz @(MaybeIn "foundnothing" (ShowP (Pred Id))) (Just 20)
PresentT "19"
>>> pz @(MaybeIn "found nothing" (ShowP (Pred Id))) 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.Prelude

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.Prelude

type PP (MaybeIn p q :: Type) (Maybe a) = PP q a

data MaybeBool 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

>>> pz @(MaybeBool (Id > 4) Id) 24
PresentT (Just 24)
>>> pz @(MaybeBool (Id > 4) Id) (-5)
PresentT Nothing
Instances
(Show (PP p a), P b a, P p a, PP b a ~ Bool) => P (MaybeBool b p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (MaybeBool b p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (MaybeBool b p :: Type) a = Maybe (PP p a)

either expressions

data PartitionEithers Source #

similar to partitionEithers

>>> pz @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]
PresentT ("ac",[2,4,99])
>>> pz @PartitionEithers [Right 2,Right 4,Right 99]
PresentT ([],[2,4,99])
>>> pz @PartitionEithers [Left 'a',Left 'c']
PresentT ("ac",[])
>>> pz @PartitionEithers ([] :: [Either () Int])
PresentT ([],[])
Instances
(Show a, Show b) => P PartitionEithers [Either a b] Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP PartitionEithers [Either a b] = ([a], [b])

data IsLeft p Source #

similar to isLeft

>>> pz @(IsLeft Id) (Right 123)
FalseT
>>> pz @(IsLeft Id) (Left 'a')
TrueT
Instances
(P p x, PP p x ~ Either a b) => P (IsLeft p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsLeft p :: Type) x = Bool

data IsRight p Source #

similar to isRight

>>> pz @(IsRight Id) (Right 123)
TrueT
>>> pz @(IsRight Id) (Left "aa")
FalseT
Instances
(P p x, PP p x ~ Either a b) => P (IsRight p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsRight p :: Type) x = Bool

data MkLeft (t :: Type) p Source #

Instances
P (MkLeftT t p) x => P (MkLeft t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkLeft t p :: Type) x

data MkLeft' t p Source #

Left constructor

>>> pz @(MkLeft _ Id) 44
PresentT (Left 44)
Instances
(Show (PP p x), P p x) => P (MkLeft' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkLeft' t p :: Type) x = Either (PP p x) (PP t x)

data MkRight (t :: Type) p Source #

Instances
P (MkRightT t p) x => P (MkRight t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkRight t p :: Type) x

data MkRight' t p Source #

Right constructor

>>> pz @(MkRight _ Id) 44
PresentT (Right 44)
Instances
(Show (PP p x), P p x) => P (MkRight' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkRight' t p :: Type) x = Either (PP t x) (PP p x)

data Left' p Source #

Instances
P (LeftT' p) x => P (Left' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Left' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (Left' p :: Type) x

data Right' p Source #

Instances
P (RightT' p) x => P (Right' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Right' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (Right' p :: Type) x

data LeftDef p q Source #

extract the Left value from an Either otherwise use the default value

if there is no Left value then p is passed the Right value and the whole context

>>> pz @(LeftDef (1 % 4) Id) (Left 20.4)
PresentT (102 % 5)
>>> pz @(LeftDef (1 % 4) Id) (Right "aa")
PresentT (1 % 4)
>>> pz @(LeftDef (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
PresentT "found right=xy fst=123"
>>> pz @(LeftDef (MEmptyT _) Id) (Right 222)
PresentT ()
>>> pz @(LeftDef (MEmptyT (SG.Sum _)) Id) (Right 222)
PresentT (Sum {getSum = 0})
Instances
(PP q x ~ Either a b, PP p (b, x) ~ a, P q x, P p (b, x)) => P (LeftDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (LeftDef p q :: Type) x

data LeftFail p q Source #

extract the Left value from an Either otherwise fail with a message

if there is no Left value then p is passed the Right value and the whole context

>>> pz @(LeftFail "oops" Id) (Left 20.4)
PresentT 20.4
>>> pz @(LeftFail "oops" Id) (Right "aa")
FailT "oops"
>>> pz @(LeftFail (PrintT "found right=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Right "xy")
FailT "found right=xy fst=123"
>>> pz @(LeftFail (MEmptyT _) Id) (Right 222)
FailT ""
Instances
(PP p (b, x) ~ String, PP q x ~ Either a b, P p (b, x), P q x) => P (LeftFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (LeftFail p q :: Type) x

data RightDef p q Source #

extract the Right value from an Either

if there is no Right value then p is passed the Left value and the whole context

>>> pz @(RightDef (1 % 4) Id) (Right 20.4)
PresentT (102 % 5)
>>> pz @(RightDef (1 % 4) Id) (Left "aa")
PresentT (1 % 4)
>>> pz @(RightDef (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
PresentT "found left=xy fst=123"
>>> pz @(RightDef (MEmptyT _) Id) (Left 222)
PresentT ()
>>> pz @(RightDef (MEmptyT (SG.Sum _)) Id) (Left 222)
PresentT (Sum {getSum = 0})
Instances
(PP q x ~ Either a b, PP p (a, x) ~ b, P q x, P p (a, x)) => P (RightDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (RightDef p q :: Type) x

data RightFail p q Source #

extract the Right value from an Either otherwise fail with a message

if there is no Right value then p is passed the Left value and the whole context

>>> pz @(RightFail "oops" Id) (Right 20.4)
PresentT 20.4
>>> pz @(RightFail "oops" Id) (Left "aa")
FailT "oops"
>>> pz @(RightFail (PrintT "found left=%s fst=%d" '(Fst Id,Fst (Snd Id))) (Snd Id)) (123,Left "xy")
FailT "found left=xy fst=123"
>>> pz @(RightFail (MEmptyT _) Id) (Left 222)
FailT ""
Instances
(PP p (a, x) ~ String, PP q x ~ Either a b, P p (a, x), P q x) => P (RightFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (RightFail p q :: Type) x

data EitherBool 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\'

>>> pz @(EitherBool (Fst Id > 4) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (24,(-1,999))
PresentT (Right 999)
>>> pz @(EitherBool (Fst Id > 4) (Fst (Snd Id)) (Snd (Snd Id))) (1,(-1,999))
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 (EitherBool b p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (EitherBool b p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (EitherBool b p q :: Type) a = Either (PP p a) (PP q a)

type EitherIn p q = p ||| q Source #

semigroup / monoid expressions

data p <> q infixr 6 Source #

similar to <>

>>> pz @(Fst Id <> Snd Id) ("abc","def")
PresentT "abcdef"
>>> pz @("abcd" <> "ef" <> Id) "ghi"
PresentT "abcdefghi"
>>> pz @("abcd" <> "ef" <> Id) "ghi"
PresentT "abcdefghi"
>>> pz @(Wrap (SG.Sum _) Id <> FromInteger _ 10) 13
PresentT (Sum {getSum = 23})
>>> pz @(Wrap (SG.Product _) Id <> FromInteger _ 10) 13
PresentT (Product {getProduct = 130})
>>> pz @('(FromInteger _ 10,"def") <> Id) (SG.Sum 12, "_XYZ")
PresentT (Sum {getSum = 22},"def_XYZ")
>>> pz @(SapA' (SG.Max _)) (10,12)
PresentT (Max {getMax = 12})
>>> pz @(SapA' (SG.Sum _)) (10,12)
PresentT (Sum {getSum = 22})
Instances
(Semigroup (PP p x), PP p x ~ PP q x, P p x, Show (PP q x), P q x) => P (p <> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <> q :: Type) x = PP p x

data MConcat p Source #

similar to mconcat

>>> pz @(MConcat Id) [SG.Sum 44, SG.Sum 12, SG.Sum 3]
PresentT (Sum {getSum = 59})
Instances
(PP p x ~ [a], P p x, Show a, Monoid a) => P (MConcat p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (MConcat p :: Type) x

data STimes n p Source #

similar to stimes

>>> pz @(STimes 4 Id) (SG.Sum 3)
PresentT (Sum {getSum = 12})
>>> pz @(STimes 4 Id) "ab"
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.Prelude

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.Prelude

type PP (STimes n p :: Type) a = PP p a

data SapA Source #

Instances
P SapAT x => P SapA x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP SapA x :: Type Source #

Methods

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

type PP SapA x Source # 
Instance details

Defined in Predicate.Prelude

type PP SapA x

data SapA' (t :: Type) Source #

Instances
P (SapAT' t) x => P (SapA' t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (SapA' t) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (SapA' t :: Type) x

data MEmptyT (t :: Type) Source #

Instances
P (MEmptyTT t) x => P (MEmptyT t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (MEmptyT t) x :: Type Source #

Methods

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

type PP (MEmptyT t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (MEmptyT t :: Type) x

data MEmptyT' t Source #

similar to mempty

>>> pz @(MEmptyT (SG.Sum Int)) ()
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.Prelude

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.Prelude

type PP (MEmptyT' t :: Type) a = PP t a

data MEmptyP Source #

Instances
P MEmptyPT x => P MEmptyP x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP MEmptyP x :: Type Source #

Methods

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

type PP MEmptyP x Source # 
Instance details

Defined in Predicate.Prelude

type PP MEmptyP x

data MEmpty2 (t :: Type) Source #

Instances
P (MEmpty2T t) x => P (MEmpty2 t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (MEmpty2 t) x :: Type Source #

Methods

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

type PP (MEmpty2 t :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (MEmpty2 t :: Type) x

data MEmpty2' t Source #

lift mempty over a Functor

>>> pz @(MEmpty2 (SG.Product Int)) [Identity (-13), Identity 4, Identity 99]
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 (MEmpty2' t :: Type) (f a) Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (MEmpty2' t :: Type) (f a) Source # 
Instance details

Defined in Predicate.Prelude

type PP (MEmpty2' t :: Type) (f a) = f (PP t (f a))

indexing expressions

data Ix (n :: Nat) def Source #

similar to !!

>>> pz @(Ix 4 "not found") ["abc","D","eF","","G"]
PresentT "G"
>>> pz @(Ix 40 "not found") ["abc","D","eF","","G"]
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.Prelude

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.Prelude

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

data Ix' (n :: Nat) Source #

Instances
P (IxT' n) x => P (Ix' n :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Ix' n) x :: Type Source #

Methods

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

type PP (Ix' n :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Ix' n :: Type) x

data IxL p q def Source #

similar to !! leveraging Ixed

>>> pz @(IxL Id 2 "notfound") ["abc","D","eF","","G"]
PresentT "eF"
>>> pz @(IxL Id 20 "notfound") ["abc","D","eF","","G"]
PresentT "notfound"
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.Prelude

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.Prelude

type PP (IxL p q r :: Type) a = IxValue (PP p a)

data p !! q Source #

similar to !! leveraging Ixed

>>> pz @(Id !! 2) ["abc","D","eF","","G"]
PresentT "eF"
>>> pz @(Id !! 20) ["abc","D","eF","","G"]
FailT "(!!) index not found"
>>> import qualified Data.Map.Strict as M
>>> pz @(Id !! "eF") (M.fromList (flip zip [0..] ["abc","D","eF","","G"]))
PresentT 2
Instances
P (BangBangT p q) a => P (p !! q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p !! q :: Type) a

data p !!? q Source #

Instances
P (BangBangQT p q) a => P (p !!? q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p !!? q :: Type) a

data Lookup p q Source #

lookup leveraging Ixed

>>> pz @(Lookup Id 2) ["abc","D","eF","","G"]
PresentT (Just "eF")
>>> pz @(Lookup Id 20) ["abc","D","eF","","G"]
PresentT Nothing
>>> pl @((Id !!? Char1 "d") > MkJust 99 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
False (False || False | (Just 4 > Just 99) || (4 <= 3))
FalseT
>>> pz @((Id !!? Char1 "d") > MkJust 2 || Length Id <= 3) (M.fromList $ zip "abcd" [1..])
TrueT
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.Prelude

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.Prelude

type PP (Lookup p q :: Type) a = Maybe (IxValue (PP p a))

data LookupDef v w p Source #

Instances
P (LookupDefT v w p) x => P (LookupDef v w p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (LookupDef v w p) x :: Type Source #

Methods

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

type PP (LookupDef v w p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (LookupDef v w p :: Type) x

data LookupDef' v w p q Source #

Instances
P (LookupDefT' v w p q) x => P (LookupDef' v w p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (LookupDef' v w p q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (LookupDef' v w p q) -> POpts -> x -> m (TT (PP (LookupDef' v w p q) x)) Source #

type PP (LookupDef' v w p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (LookupDef' v w p q :: Type) x

data LookupFail msg v w Source #

Instances
P (LookupFailT msg v w) x => P (LookupFail msg v w :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (LookupFail msg v w) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (LookupFail msg v w) -> POpts -> x -> m (TT (PP (LookupFail msg v w) x)) Source #

type PP (LookupFail msg v w :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (LookupFail msg v w :: Type) x

data LookupFail' msg v w q Source #

Instances
P (LookupFailT' msg v w q) x => P (LookupFail' msg v w q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (LookupFail' msg v w q) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (LookupFail' msg v w q) -> POpts -> x -> m (TT (PP (LookupFail' msg v w q) x)) Source #

type PP (LookupFail' msg v w q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (LookupFail' msg v w q :: Type) x

cons / uncons expressions

data p :+ q infixr 5 Source #

similar to cons

>>> pz @(Fst Id :+ Snd Id) (99,[1,2,3,4])
PresentT [99,1,2,3,4]
>>> pz @(Snd Id :+ Fst Id) ([],5)
PresentT [5]
>>> pz @(123 :+ EmptyList _) "somestuff"
PresentT [123]
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.Prelude

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.Prelude

type PP (p :+ q :: Type) x = PP q x

data p +: q infixl 5 Source #

similar to snoc

>>> pz @(Snd Id +: Fst Id) (99,[1,2,3,4])
PresentT [1,2,3,4,99]
>>> pz @(Fst Id +: Snd Id) ([],5)
PresentT [5]
>>> pz @(EmptyT [] Id +: 5) 5
PresentT [5]
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.Prelude

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.Prelude

type PP (p +: q :: Type) x = PP p x

data p ++ q infixr 5 Source #

similar to (++)

>>> pz @(Fst Id ++ Snd Id) ([9,10,11],[1,2,3,4])
PresentT [9,10,11,1,2,3,4]
>>> pz @(Snd Id ++ Fst Id) ([],[5])
PresentT [5]
>>> pz @(Char1 "xyz" :+ W "ab" ++ W "cdefg") ()
PresentT "xabcdefg"
>>> pz @([1,2,3] ++ EmptyList _) "somestuff"
PresentT [1,2,3]
Instances
(P p x, P q x, Show (PP p x), PP p x ~ [a], PP q x ~ [a]) => P (p ++ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p ++ q :: Type) x = PP q x

data Uncons Source #

uncons

>>> pz @Uncons [1,2,3,4]
PresentT (Just (1,[2,3,4]))
>>> pz @Uncons []
PresentT Nothing
>>> pz @Uncons (Seq.fromList "abc")
PresentT (Just ('a',fromList "bc"))
>>> pz @Uncons ("xyz" :: T.Text)
PresentT (Just ('x',"yz"))
Instances
(Show (ConsT s), Show s, Cons s s (ConsT s) (ConsT s)) => P Uncons s Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Uncons s = Maybe (ConsT s, s)

data Unsnoc Source #

unsnoc

>>> pz @Unsnoc [1,2,3,4]
PresentT (Just ([1,2,3],4))
>>> pz @Unsnoc []
PresentT Nothing
>>> pz @Unsnoc ("xyz" :: T.Text)
PresentT (Just ("xy",'z'))
Instances
(Show (ConsT s), Show s, Snoc s s (ConsT s) (ConsT s)) => P Unsnoc s Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Unsnoc s = Maybe (s, ConsT s)

data Head p Source #

takes the head of a list like container

>>> pz @(Head Id) "abcd"
PresentT 'a'
>>> pz @(Head Id) []
FailT "Head(empty)"
Instances
(Show (ConsT s), Show s, Cons s s (ConsT s) (ConsT s), PP p x ~ s, P p x) => P (Head p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Head p :: Type) x = ConsT (PP p x)

data Tail p Source #

takes the tail of a list like container

>>> pz @(Tail Id) "abcd"
PresentT "bcd"
>>> pz @(Tail Id) []
FailT "Tail(empty)"
Instances
(Show s, Cons s s (ConsT s) (ConsT s), PP p x ~ s, P p x) => P (Tail p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Tail p :: Type) x = PP p x

data Init p Source #

takes the init of a list like container

>>> pz @(Init Id) "abcd"
PresentT "abc"
>>> pz @(Init Id) (T.pack "abcd")
PresentT "abc"
>>> pz @(Init Id) []
FailT "Init(empty)"
Instances
(Show s, Snoc s s (ConsT s) (ConsT s), PP p x ~ s, P p x) => P (Init p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Init p :: Type) x = PP p x

data Last p Source #

takes the last of a list like container

>>> pz @(Last Id) "abcd"
PresentT 'd'
>>> pz @(Last Id) []
FailT "Last(empty)"
Instances
(Show (ConsT s), Show s, Snoc s s (ConsT s) (ConsT s), PP p x ~ s, P p x) => P (Last p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Last p :: Type) x = ConsT (PP p x)

data HeadDef p q Source #

takes the head or default of a list-like object

see ConsT for other supported types eg Seq

>>> pz @(HeadDef 444 Id) []
PresentT 444
>>> pz @(HeadDef 444 Id) [1..5]
PresentT 1
>>> pz @(HeadDef 444 Id) [1..5]
PresentT 1
>>> pz @(HeadDef (Char1 "w") Id) (Seq.fromList "abcdef")
PresentT 'a'
>>> pz @(HeadDef (Char1 "w") Id) Seq.empty
PresentT 'w'
>>> :set -XFlexibleContexts
>>> pz @(HeadDef (MEmptyT _) Id) ([] :: [SG.Sum Int])
PresentT (Sum {getSum = 0})
>>> pz @(HeadDef (MEmptyT String) '[ "abc","def","asdfadf" ]) ()
PresentT "abc"
>>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[ "abc","def","asdfadf" ])
PresentT "abc"
>>> pz @(HeadDef (MEmptyT _) (Snd Id)) (123,[])
PresentT ()
Instances
P (HeadDefT p q) x => P (HeadDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (HeadDef p q :: Type) x

data HeadFail msg q Source #

takes the head of a list or fail

see ConsT for other supported types eg Seq

>>> pz @(HeadFail "dude" Id) [ "abc","def","asdfadf" ]
PresentT "abc"
>>> pz @(HeadFail "empty list" Id) []
FailT "empty list"
Instances
P (HeadFailT msg q) x => P (HeadFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (HeadFail msg q) x :: Type Source #

Methods

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

type PP (HeadFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (HeadFail msg q :: Type) x

data TailDef p q Source #

Instances
P (TailDefT p q) x => P (TailDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TailDef p q :: Type) x

data TailFail msg q Source #

Instances
P (TailFailT msg q) x => P (TailFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (TailFail msg q) x :: Type Source #

Methods

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

type PP (TailFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (TailFail msg q :: Type) x

data LastDef p q Source #

Instances
P (LastDefT p q) x => P (LastDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (LastDef p q :: Type) x

data LastFail msg q Source #

Instances
P (LastFailT msg q) x => P (LastFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (LastFail msg q) x :: Type Source #

Methods

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

type PP (LastFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (LastFail msg q :: Type) x

data InitDef p q Source #

Instances
P (InitDefT p q) x => P (InitDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (InitDef p q :: Type) x

data InitFail msg q Source #

Instances
P (InitFailT msg q) x => P (InitFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (InitFail msg q) x :: Type Source #

Methods

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

type PP (InitFail msg q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (InitFail msg q :: Type) x

these expressions

data PartitionThese Source #

similar to partitionThese. returns a 3-tuple with the results so use Fst Snd Thd to extract

>>> pz @PartitionThese [This 'a', That 2, This 'c', These 'z' 1, That 4, These 'a' 2, That 99]
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.Prelude

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.Prelude

type PP PartitionThese [These a b] = ([a], [b], [(a, b)])

data Thiss Source #

Instances
P ThissT x => P Thiss x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Thiss x :: Type Source #

Methods

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

type PP Thiss x Source # 
Instance details

Defined in Predicate.Prelude

type PP Thiss x

data Thats Source #

Instances
P ThatsT x => P Thats x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Thats x :: Type Source #

Methods

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

type PP Thats x Source # 
Instance details

Defined in Predicate.Prelude

type PP Thats x

data Theses Source #

Instances
P ThesesT x => P Theses x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Theses x :: Type Source #

Methods

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

type PP Theses x Source # 
Instance details

Defined in Predicate.Prelude

type PP Theses x

data This' p Source #

Instances
P (ThisT' p) x => P (This' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (This' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (This' p :: Type) x

data That' p Source #

Instances
P (ThatT' p) x => P (That' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (That' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (That' p :: Type) x

data These' p Source #

Instances
P (TheseT' p) x => P (These' p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (These' p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (These' p :: Type) x

data IsThis p Source #

Instances
P (IsThisT p) x => P (IsThis p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsThis p :: Type) x

data IsThat p Source #

Instances
P (IsThatT p) x => P (IsThat p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsThat p :: Type) x

data IsThese p Source #

Instances
P (IsTheseT p) x => P (IsThese p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsThese p :: Type) x

data MkThis (t :: Type) p Source #

Instances
P (MkThisT t p) x => P (MkThis t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkThis t p :: Type) x

data MkThis' t p Source #

This constructor

>>> pz @(MkThis _ Id) 44
PresentT (This 44)
>>> pz @(Proxy Int >> MkThis' Unproxy 10) []
PresentT (This 10)
Instances
(Show (PP p x), P p x) => P (MkThis' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkThis' t p :: Type) x = These (PP p x) (PP t x)

data MkThat (t :: Type) p Source #

Instances
P (MkThatT t p) x => P (MkThat t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkThat t p :: Type) x

data MkThat' t p Source #

That constructor

>>> pz @(MkThat _ Id) 44
PresentT (That 44)
Instances
(Show (PP p x), P p x) => P (MkThat' t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (MkThat' t p :: Type) x = These (PP t x) (PP p x)

data MkThese p q Source #

These constructor

>>> pz @(MkThese (Fst Id) (Snd Id)) (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.Prelude

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.Prelude

type PP (MkThese p q :: Type) a = These (PP p a) (PP q a)

data ThisDef p q Source #

extract the This value from an These otherwise use the default value

if there is no This value then p is passed the whole context only

>>> pz @(ThisDef (1 % 4) Id) (This 20.4)
PresentT (102 % 5)
>>> pz @(ThisDef (1 % 4) Id) (That "aa")
PresentT (1 % 4)
>>> pz @(ThisDef (1 % 4) Id) (These 2.3 "aa")
PresentT (1 % 4)
>>> pz @(ThisDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,That "xy")
PresentT "found That \"xy\" fst=123"
>>> pz @(ThisDef (MEmptyT _) Id) (That 222)
PresentT ()
>>> pz @(ThisDef (MEmptyT (SG.Sum _)) Id) (These 222 'x')
PresentT (Sum {getSum = 0})
Instances
(PP q x ~ These a b, PP p x ~ a, P q x, P p x) => P (ThisDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ThisDef p q :: Type) x

data ThisFail p q Source #

extract the This value from a These otherwise fail with a message

if there is no This value then p is passed the whole context only

>>> pz @(ThisFail "oops" Id) (This 20.4)
PresentT 20.4
>>> pz @(ThisFail "oops" Id) (That "aa")
FailT "oops"
>>> pz @(ThisFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
FailT "found That \"xy\" fst=123"
>>> pz @(ThisFail (MEmptyT _) Id) (That 222)
FailT ""
Instances
(PP p x ~ String, PP q x ~ These a b, P p x, P q x) => P (ThisFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ThisFail p q :: Type) x

data ThatDef p q Source #

extract the That value from an These otherwise use the default value

if there is no That value then p is passed the whole context only

>>> pz @(ThatDef (1 % 4) Id) (That 20.4)
PresentT (102 % 5)
>>> pz @(ThatDef (1 % 4) Id) (This "aa")
PresentT (1 % 4)
>>> pz @(ThatDef (1 % 4) Id) (These "aa" 2.3)
PresentT (1 % 4)
>>> pz @(ThatDef (PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id)) (Snd Id)) (123,This "xy")
PresentT "found This \"xy\" fst=123"
>>> pz @(ThatDef (MEmptyT _) Id) (This 222)
PresentT ()
>>> pz @(ThatDef (MEmptyT (SG.Sum _)) Id) (These 'x' 1120)
PresentT (Sum {getSum = 0})
Instances
(PP q x ~ These a b, PP p x ~ b, P q x, P p x) => P (ThatDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ThatDef p q :: Type) x

data ThatFail p q Source #

extract the That value from a These otherwise fail with a message

if there is no That value then p is passed the whole context only

>>> pz @(ThatFail "oops" Id) (That 20.4)
PresentT 20.4
>>> pz @(ThatFail "oops" Id) (This "aa")
FailT "oops"
>>> pz @(ThatFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,This "xy")
FailT "found This \"xy\" fst=123"
>>> pz @(ThatFail (MEmptyT _) Id) (This 222)
FailT ""
Instances
(PP p x ~ String, PP q x ~ These a b, P p x, P q x) => P (ThatFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ThatFail p q :: Type) x

data TheseDef p q Source #

extract the These value from an These otherwise use the default value

if there is no These value then p is passed the whole context only

>>> pz @(TheseDef '(1 % 4,"zz") Id) (These 20.4 "x")
PresentT (102 % 5,"x")
>>> pz @(TheseDef '(1 % 4,"zz") Id) (This 20.4)
PresentT (1 % 4,"zz")
>>> pz @(TheseDef '(1 % 4,"zz") Id) (That "x")
PresentT (1 % 4,"zz")
>>> pz @(TheseDef '(PrintT "found %s fst=%d" '(ShowP (Snd Id), Fst Id),999) (Snd Id)) (123,This "xy")
PresentT ("found This \"xy\" fst=123",999)
>>> pz @(TheseDef (MEmptyT (SG.Sum _, String)) Id) (This 222)
PresentT (Sum {getSum = 0},"")
>>> pz @(TheseDef (MEmptyT _) Id) (These (222 :: SG.Sum Int) "aa")
PresentT (Sum {getSum = 222},"aa")
Instances
(PP q x ~ These a b, PP p x ~ (a, b), P q x, P p x) => P (TheseDef p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TheseDef p q :: Type) x

data TheseFail p q Source #

extract the These value from a These otherwise fail with a message

if there is no These value then p is passed the whole context only

>>> pz @(TheseFail "oops" Id) (These "abc" 20.4)
PresentT ("abc",20.4)
>>> pz @(TheseFail "oops" Id) (That "aa")
FailT "oops"
>>> pz @(TheseFail (PrintT "found %s fst=%d" '(ShowP (Snd Id),Fst Id)) (Snd Id)) (123,That "xy")
FailT "found That \"xy\" fst=123"
>>> pz @(TheseFail (MEmptyT _) Id) (That 222)
FailT ""
Instances
(PP p x ~ String, PP q x ~ These a b, P p x, P q x) => P (TheseFail p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TheseFail p q :: Type) x

data TheseIn p q r Source #

similar to these

>>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (This 13)
PresentT 13
>>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (That "this is a long string")
PresentT 21
>>> pz @(TheseIn Id Len (Fst Id + Length (Snd Id))) (These 20 "somedata")
PresentT 28
>>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (That "this is a long string")
PresentT (Right "this is a long string")
>>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 1 "this is a long string")
PresentT (Right "this is a long string")
>>> pz @(TheseIn (MkLeft _ Id) (MkRight _ Id) (If (Fst Id > Length (Snd Id)) (MkLeft _ (Fst Id)) (MkRight _ (Snd Id)))) (These 100 "this is a long string")
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.Prelude

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.Prelude

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

data TheseId p q Source #

Instances
P (TheseIdT p q) x => P (TheseId p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TheseId p q :: Type) x

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

>>> pz @(TheseX ((Fst (Fst Id) + Snd Id) >> ShowP Id) (ShowP Id) (Snd (Snd Id)) (Snd Id)) (9,This 123)
PresentT "132"
>>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (This 123)
PresentT (123,"fromthis")
>>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (That "fromthat")
PresentT (-99,"fromthat")
>>> pz @(TheseX '(Snd Id,"fromthis") '(Negate 99,Snd Id) (Snd Id) Id) (These 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.Prelude

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.Prelude

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

fold / unfold expressions

data Scanl p q r Source #

similar to scanl

>>> pz @(Scanl (Snd Id :+ Fst Id) (Fst Id) (Snd Id)) ([99],[1..5])
PresentT [[99],[1,99],[2,1,99],[3,2,1,99],[4,3,2,1,99],[5,4,3,2,1,99]]
>>> pz @(ScanN 4 Id (Succ Id)) 'c'
PresentT "cdefg"
>>> pz @(FoldN 4 Id (Succ Id)) 'c'
PresentT 'g'
>>> pz @(Dup >> ScanN 4 Id (Pred Id *** Succ Id)) 'g'
PresentT [('g','g'),('f','h'),('e','i'),('d','j'),('c','k')]
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.Prelude

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.Prelude

type PP (Scanl p q r :: Type) x = [PP q x]

data ScanN n p q Source #

Instances
P (ScanNT n p q) x => P (ScanN n p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ScanN n p q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (ScanN n p q :: Type) x

data ScanNA q Source #

Instances
P (ScanNAT q) x => P (ScanNA q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ScanNA q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (ScanNA q :: Type) x

data FoldN n p q Source #

Instances
P (FoldNT n p q) x => P (FoldN n p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (FoldN n p q) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (FoldN n p q :: Type) x

data FoldL p q r Source #

Instances
P (FoldLT p q r) x => P (FoldL p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FoldL p q r :: Type) x

data Unfoldr p q Source #

similar to unfoldr

>>> pz @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..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.Prelude

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.Prelude

type PP (Unfoldr p q :: Type) a

data IterateN n f Source #

like iterate but for a fixed number of elements

>>> pz @(IterateN 4 (Succ Id)) 4
PresentT [4,5,6,7]
>>> pz @('(0,1) >> IterateN 20 '(Snd Id, Fst Id + Snd Id) >> Map (Fst Id) Id) "sdf"
PresentT [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181]
Instances
P (IterateNT n f) x => P (IterateN n f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (IterateN n f) x :: Type Source #

Methods

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

type PP (IterateN n f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (IterateN n f :: Type) x

data IterateUntil p f Source #

Instances
P (IterateUntilT p f) x => P (IterateUntil p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (IterateUntil p f) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (IterateUntil p f :: Type) x

data IterateWhile p f Source #

Instances
P (IterateWhileT p f) x => P (IterateWhile p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (IterateWhile p f) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (IterateWhile p f :: Type) x

data IterateNWhile n p f Source #

Instances
P (IterateNWhileT n p f) x => P (IterateNWhile n p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (IterateNWhile n p f) x :: Type Source #

Methods

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

type PP (IterateNWhile n p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (IterateNWhile n p f :: Type) x

data IterateNUntil n p f Source #

Instances
P (IterateNUntilT n p f) x => P (IterateNUntil n p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (IterateNUntil n p f) x :: Type Source #

Methods

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

type PP (IterateNUntil n p f :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (IterateNUntil n p f :: Type) x

failure expressions

data Fail t prt Source #

Fails the computation with a message

>>> pz @(Failt Int (PrintF "value=%03d" Id)) 99
FailT "value=099"
>>> pz @(FailS (PrintT "value=%03d string=%s" Id)) (99,"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.Prelude

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.Prelude

type PP (Fail t prt :: Type) a = PP t a

data Failp p Source #

Instances
P (Fail Unproxy p) x => P (Failp p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Failp p :: Type) x = PP (Fail Unproxy p) x

data Failt (t :: Type) p Source #

Instances
P (Fail (Hole t) p) x => P (Failt t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Failt t p :: Type) x = PP (Fail (Hole t) p) x

data FailS p Source #

Instances
P (Fail I p) x => P (FailS p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FailS p :: Type) x = PP (Fail I p) x

data Catch p q Source #

catch a failure

>>> pz @(Catch (Succ Id) (Fst Id >> Second (ShowP Id) >> PrintT "%s %s" Id >> 'LT)) GT
PresentT LT
>>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) GT
FailT "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"
>>> pz @(Catch' (Succ Id) (Second (ShowP Id) >> PrintT "%s %s" Id)) LT
PresentT EQ
>>> pz @(Len > 1 && Catch (Id !! 3 == 66) 'False) [1,2]
FalseT

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.Prelude

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.Prelude

type PP (Catch p q :: Type) x = PP p x

data Catch' p s Source #

Instances
P (CatchT' p s) x => P (Catch' p s :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (Catch' p s :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Catch' p s :: Type) x

zip expressions

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

>>> pz @(ZipThese (Fst Id) (Snd Id)) ("aBc", [1..5])
PresentT [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
>>> pz @(ZipThese (Fst Id) (Snd Id)) ("aBcDeF", [1..3])
PresentT [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
>>> pz @(ZipThese Id Reverse) "aBcDeF"
PresentT [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
>>> pz @(ZipThese Id '[]) "aBcDeF"
PresentT [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
>>> pz @(ZipThese '[] Id) "aBcDeF"
PresentT [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
>>> pz @(ZipThese '[] '[]) "aBcDeF"
PresentT []
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.Prelude

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.Prelude

type PP (ZipThese p q :: Type) a

data ZipL l p q Source #

zip two lists padding the left hand side if needed

>>> pl @(ZipL 99 '[1,2,3] "abc") ()
Present [(1,'a'),(2,'b'),(3,'c')] (ZipL [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
PresentT [(1,'a'),(2,'b'),(3,'c')]
>>> pl @(ZipL 99 '[1,2] "abc") ()
Present [(1,'a'),(2,'b'),(99,'c')] (ZipL [(1,'a'),(2,'b'),(99,'c')] | p=[1,2] | q="abc")
PresentT [(1,'a'),(2,'b'),(99,'c')]
>>> pl @(ZipL 99 '[1] "abc") ()
Present [(1,'a'),(99,'b'),(99,'c')] (ZipL [(1,'a'),(99,'b'),(99,'c')] | p=[1] | q="abc")
PresentT [(1,'a'),(99,'b'),(99,'c')]
>>> pl @(ZipL 99 '[1,2,3] "ab") ()
Error ZipL(3,2) rhs would be truncated (ZipL(3,2) | p=[1,2,3] | q="ab")
FailT "ZipL(3,2) rhs would be truncated"
Instances
(PP l a ~ x, P l a, PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (ZipL l p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ZipL l p q) a :: Type Source #

Methods

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

type PP (ZipL l p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (ZipL l p q :: Type) a

data ZipR r p q Source #

zip two lists padding the right hand side if needed

>>> pl @(ZipR (Char1 "Z") '[1,2,3] "abc") ()
Present [(1,'a'),(2,'b'),(3,'c')] (ZipR [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
PresentT [(1,'a'),(2,'b'),(3,'c')]
>>> pl @(ZipR (Char1 "Z") '[1,2,3] "ab") ()
Present [(1,'a'),(2,'b'),(3,'Z')] (ZipR [(1,'a'),(2,'b'),(3,'Z')] | p=[1,2,3] | q="ab")
PresentT [(1,'a'),(2,'b'),(3,'Z')]
>>> pl @(ZipR (Char1 "Z") '[1,2,3] "a") ()
Present [(1,'a'),(2,'Z'),(3,'Z')] (ZipR [(1,'a'),(2,'Z'),(3,'Z')] | p=[1,2,3] | q="a")
PresentT [(1,'a'),(2,'Z'),(3,'Z')]
>>> pl @(ZipR (Char1 "Z") '[1,2] "abc") ()
Error ZipR(2,3) rhs would be truncated (ZipR(2,3) | p=[1,2] | q="abc")
FailT "ZipR(2,3) rhs would be truncated"
Instances
(PP r a ~ y, P r a, PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (ZipR r p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (ZipR r p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (ZipR r p q :: Type) a

data Zip p q Source #

zip two lists with the same length

>>> pl @(Zip '[1,2,3] "abc") ()
Present [(1,'a'),(2,'b'),(3,'c')] (Zip [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")
PresentT [(1,'a'),(2,'b'),(3,'c')]
>>> pl @(Zip '[1,2,3] "ab") ()
Error Zip(3,2) length mismatch (Zip(3,2) | p=[1,2,3] | q="ab")
FailT "Zip(3,2) length mismatch"
>>> pl @(Zip '[1,2] "abc") ()
Error Zip(2,3) length mismatch (Zip(2,3) | p=[1,2] | q="abc")
FailT "Zip(2,3) length mismatch"
Instances
(PP p a ~ [x], PP q a ~ [y], P p a, P q a, Show x, Show y) => P (Zip p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (Zip p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (Zip p q :: Type) a

data Unzip Source #

unzip equivalent

>>> pz @Unzip (zip [1..5] "abcd")
PresentT ([1,2,3,4],"abcd")
Instances
P UnzipT x => P Unzip x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Unzip x :: Type Source #

Methods

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

type PP Unzip x Source # 
Instance details

Defined in Predicate.Prelude

type PP Unzip x

data Unzip3 Source #

unzip3 equivalent

>>> pz @Unzip3 (zip3 [1..5] "abcd" (cycle [True,False]))
PresentT ([1,2,3,4],"abcd",[True,False,True,False])
Instances
P Unzip3T x => P Unzip3 x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Unzip3 x :: Type Source #

Methods

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

type PP Unzip3 x Source # 
Instance details

Defined in Predicate.Prelude

type PP Unzip3 x

conditional expressions

data If p q r Source #

if p then run q else run r

>>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4" ) 10
PresentT "greater than 4"
>>> pz @(If (Gt 4) "greater than 4" "less than or equal to 4") 0
PresentT "less than or equal to 4"
>>> pz @(If (Snd Id == "a") '("xxx",Fst Id + 13) (If (Snd Id == "b") '("yyy",Fst Id + 7) (Failt _ "oops"))) (99,"b")
PresentT ("yyy",106)
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.Prelude

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.Prelude

type PP (If p q r :: Type) a = PP q a

data Case (e :: k0) (ps :: [k]) (qs :: [k1]) (r :: k2) Source #

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

Defined in Predicate.Prelude

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.Prelude

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

data Case' (ps :: [k]) (qs :: [k1]) (r :: k2) Source #

Instances
P (CaseT' ps qs r) x => P (Case' ps qs r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (Case' ps qs r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Case' ps qs r :: Type) x

data Case'' s (ps :: [k]) (qs :: [k1]) (r :: k2) Source #

Instances
P (CaseT'' s ps qs r) x => P (Case'' s ps qs r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (Case'' s ps qs r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Case'' s ps qs r :: Type) x

data Guards (ps :: [(k, k1)]) Source #

Instances
([a] ~ x, GetLen ps, P (GuardsImpl (LenT ps) ps) x) => P (Guards ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Guards ps) x :: Type Source #

Methods

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

type PP (Guards ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Guards ps :: Type) x

data GuardsQuick (prt :: k) (ps :: [k1]) Source #

Instances
P (GuardsQuickT prt ps) x => P (GuardsQuick prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (GuardsQuick prt ps) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsQuick prt ps) -> POpts -> x -> m (TT (PP (GuardsQuick prt ps) x)) Source #

type PP (GuardsQuick prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (GuardsQuick prt ps :: Type) x

data Guard prt p Source #

'p' is the predicate and on failure of the predicate runs 'prt'

>>> pz @(Guard "expected > 3" (Gt 3)) 17
PresentT 17
>>> pz @(Guard "expected > 3" (Gt 3)) 1
FailT "expected > 3"
>>> pz @(Guard (PrintF "%d not > 3" Id) (Gt 3)) (-99)
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.Prelude

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.Prelude

type PP (Guard prt p :: Type) a = a

data ExitWhen prt p Source #

Instances
P (ExitWhenT prt p) x => P (ExitWhen prt p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (ExitWhen prt p) x :: Type Source #

Methods

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

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

Defined in Predicate.Prelude

type PP (ExitWhen prt p :: Type) x

data GuardSimple p Source #

similar to Guard but uses the root message of the False predicate case as the failure message

most uses of GuardSimple can be replaced by a boolean predicate unless you require a failure message instead of true/false

>>> pz @(GuardSimple (Luhn Id)) [1..4]
FailT "(Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])"
>>> pl @(Luhn Id) [1..4]
False (Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4])
FalseT
>>> pz @(GuardSimple (Luhn Id)) [1,2,3,0]
PresentT [1,2,3,0]
>>> pz @(GuardSimple (Len > 30)) [1,2,3,0]
FailT "(4 > 30)"
Instances
(Show a, P p a, PP p a ~ Bool) => P (GuardSimple p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (GuardSimple p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (GuardSimple p :: Type) a = a

data GuardsN prt (n :: Nat) p Source #

leverages RepeatT for repeating predicates (passthrough method)

>>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,256]
FailT "id=3 must be between 0 and 255, found 256"
>>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,44]
PresentT [121,33,7,44]
Instances
(x ~ [a], P (GuardsNT prt n p) x) => P (GuardsN prt n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (GuardsN prt n p) x :: Type Source #

Methods

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

type PP (GuardsN prt n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (GuardsN prt n p :: Type) x

data GuardsDetail prt (ps :: [(k0, k1)]) Source #

Instances
P (GuardsDetailT prt ps) x => P (GuardsDetail prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (GuardsDetail prt ps) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (GuardsDetail prt ps) -> POpts -> x -> m (TT (PP (GuardsDetail prt ps) x)) Source #

type PP (GuardsDetail prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (GuardsDetail prt ps :: Type) x

data Bools (ps :: [(k, k1)]) Source #

boolean guard which checks a given a list of predicates against the list of values

prefer Bools as BoolsQuick doesnt give much added value: passes in the index and the value to prt but you already have the index in the message

pulls the top message from the tree if a predicate is false

>>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,93,14]
False (Bool(1) [mm] (93 <= 59))
FalseT
>>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,94]
False (Bool(2) [<<<2 94>>>] (94 <= 59))
FalseT
>>> pl @(Bools '[ '(W "hh",Between 0 23 Id), '(W "mm",Between 0 59 Id), '(PrintT "<<<%d %d>>>" Id,Between 0 59 Id) ] ) [12,13,14]
True (Bools)
TrueT
>>> pl @(BoolsQuick "abc" '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
True (Bools)
TrueT
>>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,14]
True (Bools)
TrueT
>>> pl @(BoolsQuick (PrintT "id=%d val=%d" Id) '[Between 0 23 Id, Between 0 59 Id, Between 0 59 Id]) [12,13,99]
False (Bool(2) [id=2 val=99] (99 <= 59))
FalseT
>>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,13,14]
True (Bools)
TrueT
>>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14]
False (Bool(1) [minutes] (60 <= 59))
FalseT
>>> pl @(Bools '[ '("hours",Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] ) [12,60,14,20]
False (Bools:invalid length(4) expected 3)
FalseT
Instances
([a] ~ x, GetLen ps, P (BoolsImpl (LenT ps) ps) x, PP (BoolsImpl (LenT ps) ps) x ~ Bool) => P (Bools ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Bools ps) x :: Type Source #

Methods

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

type PP (Bools ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Bools ps :: Type) x = Bool

data BoolsQuick (prt :: k) (ps :: [k1]) Source #

Instances
(PP (Bools (ToGuardsT prt ps)) x ~ Bool, P (BoolsQuickT prt ps) x) => P (BoolsQuick prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (BoolsQuick prt ps) x :: Type Source #

Methods

eval :: MonadEval m => Proxy (BoolsQuick prt ps) -> POpts -> x -> m (TT (PP (BoolsQuick prt ps) x)) Source #

type PP (BoolsQuick prt ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (BoolsQuick prt ps :: Type) x

data BoolsN prt (n :: Nat) (p :: k1) Source #

leverages RepeatT for repeating predicates (passthrough method)

>>> pl @(BoolsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,256]
False (Bool(3) [id=3 must be between 0 and 255, found 256] (256 <= 255))
FalseT
>>> pl @(BoolsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,44]
True (Bools)
TrueT
Instances
(x ~ [a], P (BoolsNT prt n p) x) => P (BoolsN prt n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (BoolsN prt n p) x :: Type Source #

Methods

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

type PP (BoolsN prt n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (BoolsN prt n p :: Type) x

IO expressions

data ReadFile p Source #

similar to readFile

>>> pz @(ReadFile "LICENSE" >> 'Just Id >> Len > 0) ()
TrueT
>>> pz @(FileExists "xyzzy") ()
FalseT
Instances
(PP p x ~ String, P p x) => P (ReadFile p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (ReadFile p :: Type) x = Maybe String

data FileExists p Source #

Instances
P (FileExistsT p) x => P (FileExists p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FileExists p :: Type) x

data ReadDir p Source #

does the directory exists

>>> pz @(DirExists ".") ()
TrueT
Instances
(PP p x ~ String, P p x) => P (ReadDir p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (ReadDir p :: Type) x = Maybe [FilePath]

data DirExists p Source #

Instances
P (DirExistsT p) x => P (DirExists p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (DirExists p :: Type) x

data ReadEnv p Source #

read an environment variable

>>> pz @(ReadEnv "PATH" >> 'Just Id >> 'True) ()
TrueT
Instances
(PP p x ~ String, P p x) => P (ReadEnv p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (ReadEnv p :: Type) x = Maybe String

data ReadEnvAll Source #

read all the environment variables as key value pairs

Instances
P ReadEnvAll a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ReadEnvAll a = [(String, String)]

data TimeUtc Source #

get the current time using UTCTime

Instances
P TimeUtc a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP TimeUtc a :: Type Source #

Methods

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

type PP TimeUtc a Source # 
Instance details

Defined in Predicate.Prelude

type PP TimeUtc a = UTCTime

data TimeZt Source #

get the current time using ZonedTime

Instances
P TimeZt a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP TimeZt a :: Type Source #

Methods

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

type PP TimeZt a Source # 
Instance details

Defined in Predicate.Prelude

data AppendFile (s :: Symbol) p Source #

append to a file

Instances
P (AppendFileT s p) x => P (AppendFile s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (AppendFile s p :: Type) x

data WriteFile (s :: Symbol) p Source #

write to file, without overwriting

Instances
P (WriteFileT s p) x => P (WriteFile s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (WriteFile s p :: Type) x

data WriteFile' (s :: Symbol) p Source #

write to file, overwriting if needed

Instances
P (WriteFileT' s p) x => P (WriteFile' s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (WriteFile' s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (WriteFile' s p :: Type) x

data Stdout p Source #

write a string value to stdout

Instances
P (StdoutT p) x => P (Stdout p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Stdout p :: Type) x

data Stderr p Source #

write a string value to stderr

Instances
P (StderrT p) x => P (Stderr p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Stderr p :: Type) x

data Stdin Source #

read a value from stdin

Instances
P Stdin x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP Stdin x :: Type Source #

Methods

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

type PP Stdin x Source # 
Instance details

Defined in Predicate.Prelude

type PP Stdin x = String

type ReadIO (t :: Type) = ReadIO' t "Enter value" Source #

read in a value of a given type from stdin with a prompt: similar to readIO

type ReadIO' (t :: Type) s = Stdout (s <> ":") >> (Stdin >> ReadP t Id) Source #

string expressions

data ToLower Source #

converts a string IsText value to lower case

>>> pz @ToLower "HeLlO wOrld!"
PresentT "hello world!"
Instances
(Show a, IsText a) => P ToLower a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ToLower a = a

data ToUpper Source #

converts a string IsText value to upper case

>>> pz @ToUpper "HeLlO wOrld!"
PresentT "HELLO WORLD!"
Instances
(Show a, IsText a) => P ToUpper a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP ToUpper a = a

data ToTitle Source #

converts a string IsText value to title case

>>> pz @ToTitle "HeLlO wOrld!"
PresentT "Hello world!"
>>> data Color = Red | White | Blue | Green | Black deriving (Show,Eq,Enum,Bounded,Read)
>>> pz @(ToTitle >> ReadP Color Id) "red"
PresentT Red
Instances
(Show a, IsText a) => P ToTitle a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP ToTitle a :: Type Source #

Methods

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

type PP ToTitle a Source # 
Instance details

Defined in Predicate.Prelude

type PP ToTitle a = a

data TrimBoth p Source #

Instances
P (TrimBothT p) x => P (TrimBoth p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TrimBoth p :: Type) x

data TrimL p Source #

Instances
P (TrimLT p) x => P (TrimL p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TrimL p :: Type) x

data TrimR p Source #

Instances
P (TrimRT p) x => P (TrimR p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (TrimR p :: Type) x

data StripR p q Source #

Instances
P (StripRT p q) x => P (StripR p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (StripR p q :: Type) x

data StripL p q Source #

Instances
P (StripLT p q) x => P (StripL p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (StripL p q :: Type) x

data IsPrefix p q Source #

Instances
P (IsPrefixT p q) x => P (IsPrefix p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsPrefix p q :: Type) x

data IsInfix p q Source #

Instances
P (IsInfixT p q) x => P (IsInfix p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsInfix p q :: Type) x

data IsSuffix p q Source #

Instances
P (IsSuffixT p q) x => P (IsSuffix p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsSuffix p q :: Type) x

data IsPrefixI p q Source #

Instances
P (IsPrefixIT p q) x => P (IsPrefixI p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsPrefixI p q :: Type) x

data IsInfixI p q Source #

Instances
P (IsInfixIT p q) x => P (IsInfixI p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsInfixI p q :: Type) x

data IsSuffixI p q Source #

Instances
P (IsSuffixIT p q) x => P (IsSuffixI p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (IsSuffixI p q :: Type) x

data ToString p Source #

very simple conversion to a string

Instances
(ToStringC (PP p x), P p x) => P (ToString p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ToString p :: Type) x = String

data FromString (t :: Type) p Source #

Instances
P (FromStringPT t p) x => P (FromString t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FromString t p :: Type) x

data FromString' t s Source #

fromString function where you need to provide the type 't' of the result

>>> :set -XFlexibleContexts
>>> pz @(FromString (Identity _) Id) "abc"
PresentT (Identity "abc")
>>> pz @(FromString (Seq.Seq Char) Id) "abc"
PresentT (fromList "abc")
Instances
(P s a, PP s a ~ String, Show (PP t a), IsString (PP t a)) => P (FromString' t s :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (FromString' t s :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (FromString' t s :: Type) a = PP t a

print expressions

data PrintF s p Source #

uses PrintF to format output for a single value

>>> pz @(PrintF "value=%03d" Id) 12
PresentT "value=012"
>>> pz @(PrintF "%s" (Fst Id)) ("abc",'x')
PresentT "abc"
>>> pz @(PrintF "%d" (Fst Id)) ("abc",'x')
FailT "PrintF (IO e=printf: bad formatting char 'd')"
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.Prelude

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.Prelude

type PP (PrintF s p :: Type) x = String

data PrintL (n :: Nat) s p Source #

print for lists -- use PrintT as it is safer than PrintL

>>> pl @(PrintL 4 "%s %s %s %s" '[W "xyz", ShowP (Fst Id), ShowP (Snd Id), Thd Id]) (123,'x',"ab")
Present "xyz 123 'x' ab" (PrintL(4) [xyz 123 'x' ab] | s=%s %s %s %s)
PresentT "xyz 123 'x' ab"
>>> pz @(PrintL 1 "%05d" '[Id]) 123  -- tick is required for a one element list (use 'PrintF')
PresentT "00123"
>>> pz @(PrintL 2 "%d %05d" [Fst Id,Snd Id]) (29,123)
PresentT "29 00123"
>>> pl @(PrintL 3 "first=%d second=%d third=%d" Id) [10,11,12]
Present "first=10 second=11 third=12" (PrintL(3) [first=10 second=11 third=12] | s=first=%d second=%d third=%d)
PresentT "first=10 second=11 third=12"
>>> pl @(PrintL 2 "first=%d second=%d third=%d" Id) [10,11,12]
Error PrintL(2) arg count=3 (PrintL(2) wrong length 3)
FailT "PrintL(2) arg count=3"
>>> pl @(PrintL 4 "first=%d second=%d third=%d" Id) [10,11,12]
Error PrintL(4) arg count=3 (PrintL(4) wrong length 3)
FailT "PrintL(4) arg count=3"
Instances
(KnownNat n, PrintC bs, (b, bs) ~ InductListP n a, InductListC n a, PrintfArg b, PP s x ~ String, PP p x ~ [a], P s x, P p x) => P (PrintL n s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (PrintL n s p) x :: Type Source #

Methods

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

type PP (PrintL n s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (PrintL n s p :: Type) x = String

data PrintT s p Source #

print for flat n-tuples of size two or larger

>>> pl @(PrintT "%d %s %s %s" '(Fst Id, Snd Id, Snd Id,Snd Id)) (10,"Asdf")
Present "10 Asdf Asdf Asdf" (PrintT [10 Asdf Asdf Asdf] | s=%d %s %s %s)
PresentT "10 Asdf Asdf Asdf"
>>> pl @(PrintT "%c %d %s" Id) ('x', 10,"Asdf")
Present "x 10 Asdf" (PrintT [x 10 Asdf] | s=%c %d %s)
PresentT "x 10 Asdf"
>>> pz @(PrintT "fst=%s snd=%03d" Id) ("ab",123)
PresentT "fst=ab snd=123"
>>> pz @(PrintT "fst=%s snd=%03d thd=%s" Id) ("ab",123,"xx")
PresentT "fst=ab snd=123 thd=xx"
>>> pl @(PrintT "%s %d %c %s" '(W "xyz", Fst Id, Snd Id, Thd Id)) (123,'x',"ab")
Present "xyz 123 x ab" (PrintT [xyz 123 x ab] | s=%s %d %c %s)
PresentT "xyz 123 x ab"
>>> pl @(PrintT "%d %c %s" Id) (123,'x')
Error PrintT(IO e=printf: argument list ended prematurely) (PrintT s=%d %c %s)
FailT "PrintT(IO e=printf: argument list ended prematurely)"
>>> pl @(PrintT "%d %c %s" Id) (123,'x',"abc",11)
Error PrintT(IO e=printf: formatting string ended prematurely) (PrintT s=%d %c %s)
FailT "PrintT(IO e=printf: formatting string ended prematurely)"
Instances
(PrintC bs, (b, bs) ~ InductTupleP y, InductTupleC y, PrintfArg b, PP s x ~ String, PP p x ~ y, P s x, P p x, CheckT (PP p x) ~ True) => P (PrintT s p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (PrintT s p :: Type) x = String

higher order expressions

data Pure (t :: Type -> Type) p Source #

similar to pure

>>> pz @(Pure Maybe Id) 4
PresentT (Just 4)
>>> pz @(Pure [] Id) 4
PresentT [4]
>>> pz @(Pure (Either String) (Fst Id)) (13,True)
PresentT (Right 13)
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.Prelude

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.Prelude

type PP (Pure t p :: Type) x = t (PP p x)

data Pure2 (t :: Type -> Type) Source #

lift pure over a Functor

>>> pz @(Pure2 (Either String)) [1,2,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.Prelude

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.Prelude

type PP (Pure2 t :: Type) (f a) = f (t a)

data FoldMap (t :: Type) p Source #

similar to a limited form of foldMap

>>> pz @(FoldMap (SG.Sum _) Id) [44, 12, 3]
PresentT 59
>>> pz @(FoldMap (SG.Product _) Id) [44, 12, 3]
PresentT 1584
>>> type Ands' p = FoldMap SG.All p
>>> pz @(Ands' Id) [True,False,True,True]
PresentT False
>>> pz @(Ands' Id) [True,True,True]
PresentT True
>>> pz @(Ands' Id) []
PresentT True
>>> type Ors' p = FoldMap SG.Any p
>>> pz @(Ors' Id) [False,False,False]
PresentT False
>>> pz @(Ors' Id) []
PresentT False
>>> pz @(Ors' Id) [False,False,False,True]
PresentT True
>>> type AllPositive' = FoldMap SG.All (Map Positive Id)
>>> pz @AllPositive' [3,1,-5,10,2,3]
PresentT False
>>> type AllNegative' = FoldMap SG.All (Map Negative Id)
>>> pz @AllNegative' [-1,-5,-10,-2,-3]
PresentT True
>>> :set -XKindSignatures
>>> type Max' (t :: Type) = FoldMap (SG.Max t) Id -- requires t be Bounded for monoid instance
>>> pz @(Max' Int) [10,4,5,12,3,4]
PresentT 12
Instances
P (FoldMapT t p) x => P (FoldMap t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (FoldMap t p :: Type) x

data p <$ q infixl 4 Source #

similar to <$

>>> pz @(Fst Id <$ Snd Id) ("abc",Just 20)
PresentT (Just "abc")
Instances
(P p x, P q x, Show (PP p x), Functor t, PP q x ~ t c, ApplyConstT (PP q x) (PP p x) ~ t (PP p x)) => P (p <$ q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <$ q :: Type) x

data p <* q infixl 4 Source #

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

Defined in Predicate.Prelude

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.Prelude

type PP (p <* q :: Type) x = PP p x

data p *> q infixl 4 Source #

Instances
P (ArrowRT p q) x => P (p *> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p *> q :: Type) x

data FMapFst Source #

similar to fmap fst

>>> pz @FMapFst (Just (13,"Asf"))
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 FMapFst (f (a, x)) Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP FMapFst (f (a, x)) Source # 
Instance details

Defined in Predicate.Prelude

type PP FMapFst (f (a, x)) = f a

data FMapSnd Source #

similar to fmap snd

>>> pz @FMapSnd (Just ("asf",13))
PresentT (Just 13)
Instances
Functor f => P FMapSnd (f (x, a)) Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP FMapSnd (f (x, a)) Source # 
Instance details

Defined in Predicate.Prelude

type PP FMapSnd (f (x, a)) = f a

data Sequence Source #

similar to sequenceA

>>> pz @Sequence [Just 10, Just 20, Just 30]
PresentT (Just [10,20,30])
>>> pz @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]
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.Prelude

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.Prelude

type PP Sequence (t (f a)) = f (t a)

data Traverse p q Source #

Instances
P (TraverseT p q) x => P (Traverse p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Traverse p q :: Type) x

data Join Source #

similar to join

>>> pz @Join  (Just (Just 20))
PresentT (Just 20)
>>> pz @Join  ["ab","cd","","ef"]
PresentT "abcdef"
Instances
(Show (t (t a)), Show (t a), Monad t) => P Join (t (t a)) Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Join (t (t a)) = t a

data EmptyT (t :: Type -> Type) p Source #

similar to empty

>>> pz @(EmptyT Maybe Id) ()
PresentT Nothing
>>> pz @(EmptyT [] Id) ()
PresentT []
>>> pz @(EmptyT [] (Char1 "x")) (13,True)
PresentT ""
>>> pz @(EmptyT (Either String) (Fst Id)) (13,True)
PresentT (Left "")
Instances
(P p x, PP p x ~ a, Show (t a), Show a, Alternative t) => P (EmptyT t p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (EmptyT t p :: Type) x = t (PP p x)

data p <|> q infixl 3 Source #

similar to <|>

>>> pz @(Fst Id <|> Snd Id) (Nothing,Just 20)
PresentT (Just 20)
>>> pz @(Fst Id <|> Snd Id) (Just 10,Just 20)
PresentT (Just 10)
>>> pz @(Fst Id <|> Snd Id) (Nothing,Nothing)
PresentT Nothing
Instances
(P p x, P q x, Show (t b), Alternative t, t b ~ PP p x, PP q x ~ t b) => P (p <|> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p <|> q :: Type) x = PP p x

data Extract Source #

similar to extract

>>> pz @Extract (Nothing,Just 20)
PresentT (Just 20)
>>> pz @Extract (Identity 20)
PresentT 20
Instances
(Show (t a), Show a, Comonad t) => P Extract (t a) Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP Extract (t a) = a

data Duplicate Source #

similar to duplicate

>>> pz @Duplicate (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.Prelude

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.Prelude

type PP Duplicate (t a) = t (t a)

expression combinators

data (p :: k -> k1) $ (q :: k) infixr 0 Source #

like $ for expressions

>>> pl @(Fst $ Snd $ Id) ((1,2),(3,4))
Present 3 (Fst 3 | (3,4))
PresentT 3
>>> pl @((<=) 4 $ Fst $ Snd $ Id) ((1,2),(3,4))
False (4 <= 3)
FalseT
Instances
P (p q) a => P (p $ q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p $ q :: Type) a = PP (p q) a

data (q :: k) & (p :: k -> k1) infixl 1 Source #

similar to &

>>> pl @(Id & Fst & Singleton & Length) (13,"xyzw")
Present 1 (Length 1 | [13])
PresentT 1
>>> pl @(2 & (&&&) "abc") ()
Present ("abc",2) (W'(,))
PresentT ("abc",2)
>>> pl @(2 & '(,) "abc") ()
Present ("abc",2) ('(,))
PresentT ("abc",2)
>>> pl @('(,) 4 $ '(,) 7 $ "aa") ()
Present (4,(7,"aa")) ('(,))
PresentT (4,(7,"aa"))
>>> pl @(Thd $ Snd $ Fst Id) ((1,("W",9,'a')),(3,4))
Present 'a' (Thd 'a' | ("W",9,'a'))
PresentT 'a'
Instances
P (p q) a => P (q & p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (q & p :: Type) a = PP (p q) a

data Do (ps :: [k]) Source #

processes a type level list predicates running each in sequence: see >>

>>> pz @(Do [Pred Id, ShowP Id, Id &&& Len]) 9876543
PresentT ("9876542",7)
>>> pz @(Do '[W 123, W "xyz", Len &&& Id, Pred Id *** Id<>Id]) ()
PresentT (2,"xyzxyz")
Instances
P (DoExpandT ps) a => P (Do ps :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Do ps :: Type) a

data Dot (ps :: [Type -> Type]) (q :: Type) Source #

compose simple functions

>>> pl @(Dot '[Thd,Snd,Fst] Id) ((1,(2,9,10)),(3,4))
Present 10 (Thd 10 | (2,9,10))
PresentT 10
Instances
P (DotExpandT ps q) a => P (Dot ps q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Dot ps q) a :: Type Source #

Methods

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

type PP (Dot ps q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (Dot ps q :: Type) a

data RDot (ps :: [Type -> Type]) (q :: Type) Source #

reversed dot

>>> pl @(RDot '[Fst,Snd,Thd] Id) ((1,(2,9,10)),(3,4))
Present 10 (Thd 10 | (2,9,10))
PresentT 10
>>> pl @(RDot '[Fst,Snd] Id) (('a',2),(True,"zy"))
Present 2 (Snd 2 | ('a',2))
PresentT 2
Instances
P (RDotExpandT ps q) a => P (RDot ps q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (RDot ps q) a :: Type Source #

Methods

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

type PP (RDot ps q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (RDot ps q :: Type) a

data p >> q infixr 1 Source #

This is composition for predicates

>>> pz @(Fst Id >> Succ (Id !! 0)) ([11,12],'x')
PresentT 12
>>> pz @(Len *** Succ Id >> ShowP (First (Pred Id))) ([11,12],'x')
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.Prelude

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.Prelude

type PP (p >> q :: Type) a = PP q (PP p a)

data p << q infixr 1 Source #

Instances
P (LeftArrowsT p q) x => P (p << q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p << q :: Type) x

type (>>>) p q = p >> q infixl 1 Source #

data DoN (n :: Nat) p Source #

leverages Do for repeating predicates (passthrough method) same as DoN n p == FoldN n p Id but more efficient

>>> pz @(DoN 4 (Succ Id)) 'c'
PresentT 'g'
>>> pz @(DoN 4 (Id <> " | ")) "abc"
PresentT "abc |  |  |  | "
>>> pz @(DoN 4 (Id <> "|" <> Id)) "abc"
PresentT "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"
Instances
P (DoNT n p) a => P (DoN n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (DoN n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (DoN n p :: Type) a

data p $$ q infixl 0 Source #

function application for expressions: similar to $

pz @(Fst Id $$ Snd Id) ((*16),4) PresentT 64

pz @(Id $$ "def") ("abc"<>) PresentT "abcdef"

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.Prelude

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.Prelude

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

data q $& p infixr 1 Source #

flipped function application for expressions: similar to &

pz @(Snd Id $& Fst Id) ((*16),4) PresentT 64

pz @("def" $& Id) ("abc"<>) PresentT "abcdef"

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 (q $& p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (q $& p :: Type) x

data K (p :: k) (q :: k1) Source #

creates a constant expression ignoring the second argument

>>> pl @(RDot '[Fst,Snd,Thd,K "xxx"] Id) ((1,(2,9,10)),(3,4))
Present "xxx" (K'xxx)
PresentT "xxx"
>>> pl @(RDot '[Fst,Snd,Thd,K '("abc",Id)] Id) ((1,(2,9,10)),(3,4))
Present ("abc",((1,(2,9,10)),(3,4))) (K'(,))
PresentT ("abc",((1,(2,9,10)),(3,4)))
>>> pl @(Thd $ Snd $ Fst $ K Id "dud") ((1,("W",9,'a')),(3,4))
Present 'a' (Thd 'a' | ("W",9,'a'))
PresentT 'a'
>>> pl @((Thd $ Snd $ Fst $ K Id "dud") >> Pred Id) ((1,("W",9,'a')),(3,4))
Present '`' ((>>) '`' | {Pred '`' | 'a'})
PresentT '`'
Instances
P p a => P (K p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (K p q :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (K p q :: Type) a = PP p a

data Hide p Source #

run the expression 'p' but remove the subtrees

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

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Hide p :: Type) x = PP p x

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 ParseTimeP, ReadBase

Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Hole t :: Type) a = t

data Skip p Source #

just run the effect but skip the value for example for use with Stdout so it doesnt interfere with the 'a' on the rhs unless there is an failure

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

Defined in Predicate.Prelude

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.Prelude

type PP (Skip p :: Type) a = a

data p |> q infixr 1 Source #

Instances
P (SkipLT p q) x => P (p |> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p |> q :: Type) x

data p >| q infixr 1 Source #

Instances
P (SkipRT p q) x => P (p >| q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p >| q :: Type) x

data p >|> q infixr 1 Source #

Instances
P (SkipBothT p q) x => P (p >|> q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (p >|> q :: Type) x

data Uncurry (p :: Type -> Type -> Type -> Type) q r Source #

uncurry experiment

>>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2019-10-12"
False (Uncurry (2019-10-12 <= 2018-12-30))
FalseT
>>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2017-10-12"
True (Uncurry (2017-04-11 <= 2017-10-12 <= 2018-12-30))
TrueT
>>> pl @(Uncurry Between (ReadP (Day,Day) "(2017-04-11,2018-12-30)") (ReadP Day Id)) "2016-10-12"
False (Uncurry (2017-04-11 <= 2016-10-12))
FalseT
Instances
(PP q x ~ (a, b), PP (p a b (PP r x)) x ~ PP (p (Fst Id) (Snd Id) (Thd Id)) (a, b, PP r x), P q x, P r x, P (p (Fst Id) (Snd Id) (Thd Id)) (a, b, PP r x)) => P (Uncurry p q r :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Uncurry p q r :: Type) x

parallel expressions

data Para (ps :: [k]) Source #

Instances
([a] ~ x, GetLen ps, P (ParaImpl (LenT ps) ps) x) => P (Para ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

type PP (Para ps) x :: Type Source #

Methods

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

type PP (Para ps :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

type PP (Para ps :: Type) x

data ParaN (n :: Nat) p Source #

leverages Para for repeating predicates (passthrough method)

>>> pz @(ParaN 4 (Succ Id)) [1..4]
PresentT [2,3,4,5]
>>> pz @(ParaN 4 (Succ Id)) "azwxm"
FailT "Para:invalid length(5) expected 4"
>>> pz @(ParaN 4 (Succ Id)) "azwx"
PresentT "b{xy"
Instances
(P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) x, GetLen (RepeatT n p), x ~ [a]) => P (ParaN n p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (ParaN n p :: Type) x = PP (Para (RepeatT n p)) x

data Repeat (n :: Nat) p Source #

creates a promoted list of predicates and then evaluates them into a list. see PP instance for '[k]

>>> pz @(Repeat 4 (Succ Id)) 'c'
PresentT "dddd"
>>> pz @(Repeat 4 "abc") ()
PresentT ["abc","abc","abc","abc"]
Instances
P (RepeatT n p) a => P (Repeat n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

type PP (Repeat n p :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

type PP (Repeat n p :: Type) a = PP (RepeatT n p) a

miscellaneous

data Both p q Source #

applies 'p' to the first and second slot of an n-tuple

>>> pl @(Both Len (Fst Id)) (("abc",[10..17],1,2,3),True)
Present (3,8) (Both)
PresentT (3,8)
>>> pl @(Both (Pred Id) $ Fst Id) ((12,'z',[10..17]),True)
Present (11,'y') (Both)
PresentT (11,'y')
>>> pl @(Both (Succ Id) Id) (4,'a')
Present (5,'b') (Both)
PresentT (5,'b')
>>> pl @(Both Len (Fst Id)) (("abc",[10..17]),True)
Present (3,8) (Both)
PresentT (3,8)
>>> pl @(Both (ReadP Day Id) Id) ("1999-01-01","2001-02-12")
Present (1999-01-01,2001-02-12) (Both)
PresentT (1999-01-01,2001-02-12)
Instances
(ExtractL1C (PP q x), ExtractL2C (PP q x), P p (ExtractL1T (PP q x)), P p (ExtractL2T (PP q x)), P q x) => P (Both p q :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Both p q :: Type) x

data Prime p Source #

a predicate on prime numbers

>>> pz @(Prime Id) 2
TrueT
>>> pz @(Map '(Id,Prime Id) Id) [0..12]
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
(PP p x ~ a, P p x, Show a, Integral a) => P (Prime p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Prime p :: Type) x = Bool

data PrimeNext p Source #

get the next prime number

>>> pz @(PrimeNext Id) 6
PresentT 7
>>> pz @(IterateN 4 (PrimeNext Id)) 3
PresentT [3,5,7,11]
Instances
(PP p x ~ a, P p x, Show a, Integral a) => P (PrimeNext p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (PrimeNext p :: Type) x = Int

data Luhn p Source #

Luhn predicate check on last digit

>>> pz @(Luhn Id) [1,2,3,0]
TrueT
>>> pz @(Luhn Id) [1,2,3,4]
FalseT
>>> pz @(GuardSimple (Luhn Id)) [15,4,3,1,99]
FailT "(Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])"
>>> pl @(Luhn Id) [15,4,3,1,99]
False (Luhn map=[90,2,3,8,6] sum=109 ret=9 | [15,4,3,1,99])
FalseT
Instances
(PP p x ~ [Int], P p x) => P (Luhn p :: Type) x Source # 
Instance details

Defined in Predicate.Prelude

Associated Types

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

Methods

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

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

Defined in Predicate.Prelude

type PP (Luhn p :: Type) x = Bool

data Char1 (s :: Symbol) Source #

extracts the first character from a non empty Symbol

>>> pz @(Char1 "aBc") ()
PresentT 'a'
Instances
(KnownSymbol s, CmpSymbol s "" ~ GT) => P (Char1 s :: Type) a Source # 
Instance details

Defined in Predicate.Prelude

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.Prelude

type PP (Char1 s :: Type) a = Char

tuples

type Tuple2 p = '(p !! 0, p !! 1) Source #

type Tuple3 p = '(p !! 0, p !! 1, p !! 2) Source #

type Tuple4 p = '(p !! 0, p !! 1, p !! 2, p !! 3) Source #

type Tuple5 p = '(p !! 0, p !! 1, p !! 2, p !! 3, p !! 4) Source #

type Tuple6 p = '(p !! 0, p !! 1, p !! 2, p !! 3, p !! 4, p !! 5) Source #