| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Predicate.Data.These
Description
promoted These functions
Synopsis
- data IsThis
- data IsThat
- data IsThese
- data MkThis (t :: Type) p
- data MkThis' t p
- data MkThat (t :: Type) p
- data MkThat' t p
- data MkThese p q
- data This'
- data That'
- data These'
- data ThisDef p q
- data ThisFail p q
- data ThatDef p q
- data ThatFail p q
- data TheseDef p q
- data TheseFail p q
- data Thiss
- data Thats
- data Theses
- data Theres
- data Heres
- data TheseIn p q r s t
- data TheseId p q r
- data ThesePair s t
- data ThisDef' p q r
- data ThatDef' p q r
- data TheseDef' p q r
- data TheseInSimple p q r
- data PartitionThese
- data ZipThese p q
- type family TheseInT r y elr where ...
predicates
predicate on This
>>>pz @IsThis (This "aBc")Val True
>>>pz @IsThis (These 1 'a')Val False
>>>pl @IsThis (This 12)True (IsThis | This 12) Val True
predicate on That
>>>pl @IsThat (This 12)False (IsThat | This 12) Val False
predicate on These
>>>pl @IsThese (This 12)False (IsThese | This 12) Val False
>>>pz @IsThese (These 1 'a')Val True
>>>pl @IsThese (These 'x' 12)True (IsThese | These 'x' 12) Val True
>>>pl @IsThese (That (SG.Sum 12))False (IsThese | That (Sum {getSum = 12})) Val False
>>>pl @IsThese (These 1 (SG.Sum 12))True (IsThese | These 1 (Sum {getSum = 12})) Val True
constructors
data MkThis (t :: Type) p Source #
This constructor
>>>pl @(MkThis () Id) 'x'Present This 'x' (MkThis This 'x') Val (This 'x')
>>>pl @(MkThis () Fst) ('x',True)Present This 'x' (MkThis This 'x') Val (This 'x')
>>>pz @(MkThis _ Id) 44Val (This 44)
This constructor
>>>pz @(Proxy Int >> MkThis' UnproxyT 10) []Val (This 10)
data MkThat (t :: Type) p Source #
That constructor
>>>pz @(MkThat _ Id) 44Val (That 44)
>>>pz @(MkThat _ "Abc" <> MkThis _ '[1,2] <> MkThese [3,4] "def") ()Val (These [1,2,3,4] "Abcdef")
>>>pl @(MkThat () Id) 'x'Present That 'x' (MkThat That 'x') Val (That 'x')
similar to MkThat where t references the type
These constructor
>>>pz @(MkThese Fst Snd) (44,'x')Val (These 44 'x')
>>>pl @(MkThese Id 'True) 'x'Present These 'x' True (MkThese These 'x' True) Val (These 'x' True)
destructors
tries to extract a value from the This constructor
>>>pz @(This' >> Succ) (This 20)Val 21
>>>pz @(This' >> Succ) (That 'a')Fail "This' found That"
tries to extract a value from the That constructor
>>>pz @(That' >> Succ) (That 20)Val 21
>>>pz @(That' >> Succ) (This 'a')Fail "That' found This"
tries to extract the values from the These constructor
>>>pz @(These' >> Second Succ) (These 1 'a')Val (1,'b')
>>>pz @(That' >> Succ) (This 'a')Fail "That' found This"
>>>pz @(These' >> Second Succ) (That 8)Fail "These' found That"
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)Val (102 % 5)
>>>pz @(ThisDef (1 % 4) Id) (That "aa")Val (1 % 4)
>>>pz @(ThisDef (1 % 4) Id) (These 2.3 "aa")Val (1 % 4)
>>>pz @(ThisDef (PrintT "found %s fst=%d" '(ShowP Snd, Fst)) Snd) (123,That "xy")Val "found That \"xy\" fst=123"
>>>pz @(ThisDef (MEmptyT _) Id) (That 222)Val ()
>>>pz @(ThisDef (MEmptyT (SG.Sum _)) Id) (These 222 'x')Val (Sum {getSum = 0})
>>>pl @(ThisDef (MEmptyT _) Id) (This (SG.Sum 12))Present Sum {getSum = 12} (ThisDef This) Val (Sum {getSum = 12})
>>>pl @(ThisDef (MEmptyT _) Id) (That 12)Present () (ThisDef That) Val ()
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)Val 20.4
>>>pz @(ThisFail "oops" Id) (That "aa")Fail "oops"
>>>pz @(ThisFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,That "xy")Fail "found That \"xy\" fst=123"
>>>pz @(ThisFail (MEmptyT _) Id) (That 222)Fail ""
>>>pl @(ThisFail "sdf" Id) (This (SG.Sum 12))Present Sum {getSum = 12} (This) Val (Sum {getSum = 12})
>>>pl @(ThisFail "sdf" Id) (That (SG.Sum 12))Error sdf (ThisFail That) Fail "sdf"
>>>pl @(ThisFail "sdf" Id) (That 12)Error sdf (ThisFail That) Fail "sdf"
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)Val (102 % 5)
>>>pz @(ThatDef (1 % 4) Id) (This "aa")Val (1 % 4)
>>>pz @(ThatDef (1 % 4) Id) (These "aa" 2.3)Val (1 % 4)
>>>pz @(ThatDef (PrintT "found %s fst=%d" '(ShowP Snd, Fst)) Snd) (123,This "xy")Val "found This \"xy\" fst=123"
>>>pz @(ThatDef (MEmptyT _) Id) (This 222)Val ()
>>>pz @(ThatDef (MEmptyT (SG.Sum _)) Id) (These 'x' 1120)Val (Sum {getSum = 0})
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)Val 20.4
>>>pz @(ThatFail "oops" Id) (This "aa")Fail "oops"
>>>pz @(ThatFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,This "xy")Fail "found This \"xy\" fst=123"
>>>pz @(ThatFail (MEmptyT _) Id) (This 222)Fail ""
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")Val (102 % 5,"x")
>>>pz @(TheseDef '(1 % 4,"zz") Id) (This 20.4)Val (1 % 4,"zz")
>>>pz @(TheseDef '(1 % 4,"zz") Id) (That "x")Val (1 % 4,"zz")
>>>pz @(TheseDef '(PrintT "found %s fst=%d" '(ShowP Snd, Fst),999) Snd) (123,This "xy")Val ("found This \"xy\" fst=123",999)
>>>pz @(TheseDef (MEmptyT (SG.Sum _, String)) Id) (This 222)Val (Sum {getSum = 0},"")
>>>pz @(TheseDef (MEmptyT _) Id) (These (SG.Sum 222) "aa")Val (Sum {getSum = 222},"aa")
>>>pl @(TheseDef '("xyz",'True) Id) (This "abc")Present ("xyz",True) (TheseDef This) Val ("xyz",True)
>>>pl @(TheseDef '("xyz",'True) Id) (That False)Present ("xyz",True) (TheseDef That) Val ("xyz",True)
>>>pl @(TheseDef '("xyz",'True) Id) (These "abc" False)Present ("abc",False) (TheseDef These) Val ("abc",False)
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)Val ("abc",20.4)
>>>pz @(TheseFail "oops" Id) (That "aa")Fail "oops"
>>>pz @(TheseFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,That "xy")Fail "found That \"xy\" fst=123"
>>>pz @(TheseFail (MEmptyT _) Id) (That 222)Fail ""
similar to catThis
>>>pz @(Thiss) [That 1, This 'a', These 'b' 33, This 'd', That 4]Val "ad"
>>>pz @(Thiss) [That 1, This 'a', These 'b' 33]Val "a"
>>>pz @(Thiss) [That 1, That 9, These 1 33]Val []
similar to catThat
>>>pl @Thats [This 1, This 10,That 'x', This 99, That 'y']Present "xy" ((>>) "xy" | {Snd "xy" | ([1,10,99],"xy",[])}) Val "xy"
similar to catThese
>>>pz @(ZipThese Id Tail >> Theses) [1..10]Val [(1,2),(2,3),(3,4),(4,5),(5,6),(6,7),(7,8),(8,9),(9,10)]
similar to catThere
>>>pz @(ZipThese Id Tail >> Theres) [1..10]Val [2,3,4,5,6,7,8,9,10]
similar to catHere
>>>pz @(ZipThese Id Tail >> Heres) [1..10]Val [1,2,3,4,5,6,7,8,9,10]
data TheseIn p q r s t Source #
destructor for These (similar to these but with an extra environment s)
p This a receives (PP t x,a)
q That b receives (PP t x,b)
r These a b receives (PP t x,(a,b))
s points to the environment you want to pass in
t points to the These value
>>>pz @(TheseIn Snd Fst L21 Fst Snd) (999,This 123)Val 123
>>>pz @(TheseIn Snd Fst L21 Fst Snd) (999,That 123)Val 999
>>>pz @(TheseIn Snd Fst L21 Fst Snd) (999,These 9 11)Val 9
>>>pz @(TheseIn '(Snd,L12) '(L11,Snd) Snd Fst Snd) ((999,'a'), These 12 'x')Val (12,'x')
>>>pz @(TheseIn '(Snd,L12) '(L11,Snd) Snd Fst Snd) ((999,'a'), That 'z')Val (999,'z')
>>>pz @(TheseIn Snd (Snd >> Len) (Snd >> Fst + Length Snd) () Id) (This 13)Val 13
>>>pz @(TheseIn Snd (Snd >> Len) (Snd >> Fst + Length Snd) () Id) (That "abcdef")Val 6
>>>pl @(TheseIn "left" "right" "both" () Id) (This (SG.Sum 12))Present "left" (TheseIn "left" | This Sum {getSum = 12}) Val "left"
>>>pl @(TheseIn '(Snd,999) '("no value",Snd) Snd () Id) (These "Ab" 13)Present ("Ab",13) (TheseIn ("Ab",13) | These "Ab" 13) Val ("Ab",13)
>>>pl @(TheseIn '(Snd,999) '("no value",Snd) Snd () Id) (This "Ab")Present ("Ab",999) (TheseIn ("Ab",999) | This "Ab") Val ("Ab",999)
>>>pz @(TheseIn ((Fst + Snd) >> ShowP Id) Snd "Xx" Fst Snd) (9,This 123)Val "132"
>>>pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (This 123)Val (123,"fromthis")
>>>pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (That "fromthat")Val (-99,"fromthat")
>>>pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (These 123 "fromthese")Val (123,"fromthese")
>>>pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (These @Int 9 "rhs")Present "a=9 b=rhs" (TheseIn "a=9 b=rhs" | These 9 "rhs") Val "a=9 b=rhs"
>>>pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (This @Int 9)Present "a=10" (TheseIn "a=10" | This 9) Val "a=10"
>>>pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (That @Int "rhs")Present "b=rhs" (TheseIn "b=rhs" | That "rhs") Val "b=rhs"
>>>pz @(TheseIn ((Fst + Snd) >> ShowP Id) (ShowP Id) L22 Fst Snd) (9,This 123)Val "132"
Instances
| (Show a, Show b, Show (PP r (y, (a, b))), P p (y, a), P q (y, b), P r (y, (a, b)), PP p (y, a) ~ PP q (y, b), PP q (y, b) ~ PP r (y, (a, b)), P s x, P t x, PP s x ~ y, PP t x ~ These a b) => P (TheseIn p q r s t :: Type) x Source # | |
| Show (TheseIn p q r s t) Source # | |
| type PP (TheseIn p q r s t :: Type) x Source # | |
simple version of TheseIn with Id as the These value and the environment set to ()
>>>pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (These 222 "ok")Val (222,"ok")
>>>pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (That "ok")Val (888,"ok")
>>>pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (This 123)Val (123,"fromleft")
provide the default pair in s and t refers to These
>>>pz @(ThesePair Fst Snd) ((999,"oops"),These 2 "xx")Val (2,"xx")
>>>pz @(ThesePair Fst Snd) ((999,"oops"),That "ok")Val (999,"ok")
get This or use the default value p: q is the environment and r is the These value
>>>pz @(ThisDef' Id Fst Snd) (999,These 1 "xx")Val 999
>>>pz @(ThisDef' 999 () Id) (That "sdf")Val 999
>>>pz @(ThisDef' 999 () Id) (This 1)Val 1
get That or use the default value p: q is the environment and r is the These value
>>>pz @(ThatDef' 999 () Id) (These "x" 1)Val 999
>>>pz @(ThatDef' 999 () Id) (This "sdf")Val 999
>>>pz @(ThatDef' 999 Fst Snd) (999,That 1)Val 1
get These or use the default value p: q is the environment and r is the These value
>>>pz @(TheseDef' '(999,"xx") () Id) (These 12 "yy")Val (12,"yy")
>>>pz @(TheseDef' '(999,"xx") () Id) (That "abc")Val (999,"xx")
>>>pz @(TheseDef' '(999,"xx") () Id) (This 1)Val (999,"xx")
>>>pz @(TheseDef' '(999,"xx") () Id) (These 1 "abc")Val (1,"abc")
>>>pz @(TheseDef' Id Fst Snd) ((999,"xx"),That "yy")Val (999,"xx")
data TheseInSimple p q r Source #
similar to these but without any environment
>>>pz @(TheseInSimple Id Len (Fst + Length Snd)) (This 13)Val 13
>>>pz @(TheseInSimple Id Len (Fst + Length Snd)) (That "this is a long string")Val 21
>>>pz @(TheseInSimple Id Len (Fst + Length Snd)) (These 20 "somedata")Val 28
>>>pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (That "this is a long string")Val (Right "this is a long string")
>>>pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 1 "this is a long string")Val (Right "this is a long string")
>>>pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 100 "this is a long string")Val (Left 100)
>>>pl @(TheseInSimple "this" "that" "these") (This (SG.Sum 12))Present "this" (TheseIn "this" | This Sum {getSum = 12}) Val "this"
>>>pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (These "Ab" 13)Present ("Ab",13) (TheseIn ("Ab",13) | These "Ab" 13) Val ("Ab",13)
>>>pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (This "Ab")Present ("Ab",999) (TheseIn ("Ab",999) | This "Ab") Val ("Ab",999)
>>>pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (That 13)Present ("no value",13) (TheseIn ("no value",13) | That 13) Val ("no value",13)
Instances
| P (TheseInSimpleT p q r) x => P (TheseInSimple p q r :: Type) x Source # | |
Defined in Predicate.Data.These Associated Types type PP (TheseInSimple p q r) x Source # Methods eval :: MonadEval m => proxy (TheseInSimple p q r) -> POpts -> x -> m (TT (PP (TheseInSimple p q r) x)) Source # | |
| Show (TheseInSimple p q r) Source # | |
Defined in Predicate.Data.These Methods showsPrec :: Int -> TheseInSimple p q r -> ShowS # show :: TheseInSimple p q r -> String # showList :: [TheseInSimple p q r] -> ShowS # | |
| type PP (TheseInSimple p q r :: Type) x Source # | |
Defined in Predicate.Data.These | |
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]Val ("ac",[2,4,99],[('z',1),('a',2)])
>>>pl @PartitionThese [This 4, That 'x', That 'y',These 3 'b', This 99, These 5 'x']Present ([4,99],"xy",[(3,'b'),(5,'x')]) (PartitionThese ([4,99],"xy",[(3,'b'),(5,'x')]) | [This 4,That 'x',That 'y',These 3 'b',This 99,These 5 'x']) Val ([4,99],"xy",[(3,'b'),(5,'x')])
>>>pl @PartitionThese [This 1,That 'x',This 4,That 'y',These 9 'z',This 10,These 8 'y']Present ([1,4,10],"xy",[(9,'z'),(8,'y')]) (PartitionThese ([1,4,10],"xy",[(9,'z'),(8,'y')]) | [This 1,That 'x',This 4,That 'y',These 9 'z',This 10,These 8 'y']) Val ([1,4,10],"xy",[(9,'z'),(8,'y')])
Instances
| Show PartitionThese Source # | |
Defined in Predicate.Data.These Methods showsPrec :: Int -> PartitionThese -> ShowS # show :: PartitionThese -> String # showList :: [PartitionThese] -> ShowS # | |
| (Show a, Show b) => P PartitionThese [These a b] Source # | |
Defined in Predicate.Data.These Associated Types type PP PartitionThese [These a b] Source # | |
| type PP PartitionThese [These a b] Source # | |
Defined in Predicate.Data.These | |
miscellaneous
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 Snd) ("aBc", [1..5])Val [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]
>>>pz @(ZipThese Fst Snd) ("aBcDeF", [1..3])Val [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']
>>>pz @(ZipThese Id Reverse) "aBcDeF"Val [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']
>>>pz @(ZipThese Id '[]) "aBcDeF"Val [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']
>>>pz @(ZipThese '[] Id) "aBcDeF"Val [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']
>>>pz @(ZipThese '[] '[]) "aBcDeF"Val []
>>>pl @(ZipThese Fst Snd >> Map (TheseInSimple Id Id Fst)) (['w'..'y'],['a'..'f'])Present "wxydef" ((>>) "wxydef" | {Map "wxydef" | [These 'w' 'a',These 'x' 'b',These 'y' 'c',That 'd',That 'e',That 'f']}) Val "wxydef"
>>>pl @(("sdf" &&& Id) >> ZipThese Fst Snd >> Map (TheseInSimple (Id &&& 0) (C "x" &&& Id) Id)) [1..5]Present [('s',1),('d',2),('f',3),('x',4),('x',5)] ((>>) [('s',1),('d',2),('f',3),('x',4),('x',5)] | {Map [('s',1),('d',2),('f',3),('x',4),('x',5)] | [These 's' 1,These 'd' 2,These 'f' 3,That 4,That 5]}) Val [('s',1),('d',2),('f',3),('x',4),('x',5)]