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

Safe HaskellNone
LanguageHaskell2010

Predicate.Data.Tuple

Description

promoted tuple functions

Synopsis

Documentation

data Dup Source #

duplicate a value into a tuple

>>> pl @Dup 4
Present (4,4) (W '(4,4))
PresentT (4,4)
>>> pl @(Dup >> Id) 4
Present (4,4) ((>>) (4,4) | {Id (4,4)})
PresentT (4,4)
>>> pl @(Dup << Fst Id * Snd Id) (4,5)
Present (20,20) ((>>) (20,20) | {W '(20,20)})
PresentT (20,20)
>>> pl @(Fst Id * Snd Id >> Dup) (4,5)
Present (20,20) ((>>) (20,20) | {W '(20,20)})
PresentT (20,20)
Instances
Show x => P Dup x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

type PP Dup x

data First p Source #

applies a function against the first part of a tuple: similar to first

>>> pz @(First (Succ Id)) (12,True)
PresentT (13,True)
Instances
P (FirstT p) x => P (First p :: Type) x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

type PP (First p :: Type) x

data Second q Source #

applies a function against the second part of a tuple: similar to second

>>> pz @(Second (Succ Id)) (12,False)
PresentT (12,True)
Instances
P (SecondT q) x => P (Second q :: Type) x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

type PP (Second q :: Type) x

data p &&& q infixr 3 Source #

similar to &&&

>>> pl @(Min &&& Max >> Id >> Fst Id < Snd Id) [10,4,2,12,14]
True ((>>) True | {2 < 14})
TrueT
>>> pl @((123 &&& Id) >> Fst Id + Snd Id) 4
Present 127 ((>>) 127 | {123 + 4 = 127})
PresentT 127
>>> pl @(4 &&& "sadf" &&& 'LT) ()
Present (4,("sadf",LT)) (W '(4,("sadf",LT)))
PresentT (4,("sadf",LT))
>>> pl @(Id &&& '() &&& ()) (Just 10)
Present (Just 10,((),())) (W '(Just 10,((),())))
PresentT (Just 10,((),()))
>>> pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,'x',True)
Present (1,('x',(True,()))) (W '(1,('x',(True,()))))
PresentT (1,('x',(True,())))
>>> pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,'x',True)
Present (1,('x',(True,()))) (W '(1,('x',(True,()))))
PresentT (1,('x',(True,())))
>>> pl @(Fst Id &&& Snd Id &&& Thd Id &&& ()) (1,1.4,"aaa")
Present (1,(1.4,("aaa",()))) (W '(1,(1.4,("aaa",()))))
PresentT (1,(1.4,("aaa",())))
Instances
P (WAmpT p q) x => P (p &&& q :: Type) x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

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)
>>> pl @(4 *** "sadf" *** 'LT) ('x',("abv",[1]))
Present (4,("sadf",LT)) ((***) (4,("sadf",LT)) | ('x',("abv",[1])))
PresentT (4,("sadf",LT))
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.Data.Tuple

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.Data.Tuple

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

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"
>>> pl @Pairs ([] :: [()])
Error Pairs no data found (Pairs no data found)
FailT "Pairs no data found"
>>> pl @Pairs [1]
Error Pairs only one element found (Pairs only one element found)
FailT "Pairs only one element found"
>>> pl @Pairs [1,2]
Present [(1,2)] (Pairs [(1,2)] | [1,2])
PresentT [(1,2)]
>>> pl @Pairs [1,2,3]
Present [(1,2),(2,3)] (Pairs [(1,2),(2,3)] | [1,2,3])
PresentT [(1,2),(2,3)]
>>> pl @Pairs [1,2,3,4]
Present [(1,2),(2,3),(3,4)] (Pairs [(1,2),(2,3),(3,4)] | [1,2,3,4])
PresentT [(1,2),(2,3),(3,4)]
Instances
Show a => P Pairs [a] Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

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

data AndA p q r Source #

applies 'p' to lhs of the tuple and 'q' to the rhs and then 'Ands' them together

>>> pl @(AndA (Gt 3) (Lt 10) Id) (1,2)
False (False (&*) True | (1 > 3))
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.Data.Tuple

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.Data.Tuple

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

data p &* q infixr 3 Source #

applies 'p' to lhs of the tuple and 'q' to the rhs and then 'Ands' them together

>>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) ()
False ((>>) False | {False (&*) True | (4 > 4)})
FalseT
Instances
P (AndAT p q) x => P (p &* q :: Type) x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

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

data OrA p q r Source #

applies 'p' to lhs of the tuple and 'q' to the rhs and then 'Ors' them together

>>> pl @(OrA (Gt 3) (Lt 10) Id) (1,2)
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.Data.Tuple

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.Data.Tuple

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

data p |+ q infixr 3 Source #

applies 'p' to lhs of the tuple and 'q' to the rhs and then 'Ors' them together

>>> 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
P (OrAT p q) x => P (p |+ q :: Type) x Source # 
Instance details

Defined in Predicate.Data.Tuple

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.Data.Tuple

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