predicate-typed 0.5.0.0 → 0.5.1.0
raw patch · 18 files changed
+946/−595 lines, 18 files
Files
- predicate-typed.cabal +2/−2
- src/Predicate/Core.hs +31/−5
- src/Predicate/Examples/Common.hs +67/−27
- src/Predicate/Examples/Refined2.hs +24/−14
- src/Predicate/Examples/Refined3.hs +22/−9
- src/Predicate/Prelude.hs +627/−356
- src/Predicate/Refined.hs +16/−24
- src/Predicate/Refined2.hs +7/−11
- src/Predicate/Refined3.hs +6/−10
- src/Predicate/Util.hs +16/−12
- src/Predicate/Util_TH.hs +19/−19
- test/TastyExtras.hs +1/−1
- test/TestJson.hs +1/−1
- test/TestPredicate.hs +39/−39
- test/TestRefined.hs +12/−12
- test/TestRefined2.hs +26/−26
- test/TestRefined3.hs +26/−26
- test/TestSpec.hs +4/−1
predicate-typed.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f56c30f55446622bc507d4f9ce667c24f908d4bdb71e657e70d96a0c6459e5fd+-- hash: cb25822f4cf9d47fb5e8793e47a05aba5041df2929f5497e50d7897f9f1d6c17 name: predicate-typed-version: 0.5.0.0+version: 0.5.1.0 synopsis: Predicates, Refinement types and Dsl description: Please see the README on GitHub at <https://github.com/gbwey/predicate-typed#readme> category: Data
src/Predicate/Core.hs view
@@ -43,6 +43,7 @@ -- ** evaluation methods , runPQ + , runPQBool , evalBool , evalQuick -- , prtTreeX @@ -223,6 +224,16 @@ -- Present (4,"hello","goodbye") -- PresentT (4,"hello","goodbye") -- +-- >>> pe @'( 'True, 'False, 123) True +-- P '(,,) +-- | +-- +- True 'True +-- | +-- +- False 'False +-- | +-- `- P '123 +-- PresentT (True,False,123) +-- instance (P p a , P q a , P r a @@ -562,9 +573,6 @@ let b = Proxy @a in pure $ mkNode opts (PresentT b) ["'Proxy" <> show1 opts " | " a] [] --- End non-Type kinds ------------------------ - pe, pe2, pe2n, pu, pun, pe3, pl, plc, pz :: forall p a . (Show (PP p a), P p a) => a -> IO (BoolT (PP p a)) -- | displays the evaluation tree in plain text without colors pe = peWith @p o0 @@ -607,8 +615,8 @@ tm = if oDebug opts == OZero then "" else topMessage pp in (<>"\n") $ case r of FailT e -> f "Error" <> " " <> e - TrueT -> f "True " <> tm - FalseT -> f "False " <> tm + TrueT -> f "True" <> " " <> tm + FalseT -> f "False" <> " " <> tm PresentT x -> f "Present" <> " " <> show x <> " " <> tm else prtTreePure opts (fromTT pp) @@ -626,6 +634,24 @@ Left e -> pure $ Left e Right p -> do qq <- eval proxyq opts a + pure $ case getValueLR opts msg0 qq (hhs <> [hh pp]) of + Left e -> Left e + Right q -> Right (p, q, pp, qq) + +runPQBool :: (P p a, PP p a ~ Bool, P q a, PP q a ~ Bool, MonadEval m) + => String + -> Proxy p + -> Proxy q + -> POpts + -> a + -> [Holder] + -> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))) +runPQBool msg0 proxyp proxyq opts a hhs = do + pp <- evalBool proxyp opts a + case getValueLR opts msg0 pp hhs of + Left e -> pure $ Left e + Right p -> do + qq <- evalBool proxyq opts a pure $ case getValueLR opts msg0 qq (hhs <> [hh pp]) of Left e -> Left e Right q -> Right (p, q, pp, qq)
src/Predicate/Examples/Common.hs view
@@ -26,8 +26,8 @@ , Dtip , Dtfmt , DdmmyyyyRE - , Ddmmyyyyval - , Ddmmyyyyval' + , Ddmmyyyyop + , Ddmmyyyyop' -- *** time checkers , Hmsip @@ -43,6 +43,7 @@ , Luhnip , Luhnop , Luhn' + , Luhnop' , Luhn'' -- , Luhnfmt @@ -70,12 +71,16 @@ import Predicate.Core import Predicate.Prelude import Predicate.Util -import GHC.TypeLits (AppendSymbol, Nat) +import GHC.TypeLits (Nat) import Data.Time -import qualified Data.Semigroup as SG +-- | \'ip\' type for converting a credit card number to a list of singleton digits type Ccip = Map (ReadP Int Id) (Ones (Remove "-" Id)) + +-- | \'op\' type for validating a credit card number by check digit type Ccop (n :: Nat) = Guard (PrintT "expected %d digits but found %d" '(n,Len)) (Len == n) >> Luhn Id + +-- | \'fmt\' type for formatting a credit card using \'ns\' as the format type Ccfmt (ns :: [Nat]) = ConcatMap (ShowP Id) Id >> SplitAts ns Id >> Concat (Intercalate '["-"] Id) -- | uses builtin 'Luhn' @@ -83,85 +88,120 @@ type Luhnop (n :: Nat) = Msg "incorrect number of digits:" (Len == n) && Luhn Id -- now that time is actually validated we dont need Dtop* +-- | \'ip\' type for reading in a date time type Dtip t = ParseTimeP t "%F %T" Id +-- | \'fmt\' type for formatting the date time compatible ith 'Dtip' type Dtfmt = FormatTimeP "%F %T" Id +-- | \'ip\' type for reading in a ssn type Ssnip = Map (ReadP Int Id) (Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> Snd (OneP Id)) +-- | \'op\' type for validating a ssn type Ssnop = BoolsQuick (PrintT "number for group %d invalid: found %d" Id) - '[Between 1 899 && Id /= 666, Between 1 99, Between 1 9999] + '[Between 1 899 Id && Id /= 666, Between 1 99 Id, Between 1 9999 Id] {- type Ssnop' = GuardsDetail "%s invalid: found %d" - '[ '("first", Between 1 899 && Id /= 666) - , '("second", Between 1 99) - , '("third" , Between 1 9999) + '[ '("first", Between 1 899 Id && Id /= 666) + , '("second", Between 1 99 Id) + , '("third" , Between 1 9999 Id) ] >> 'True -} + +-- | \'fmt\' type for formatting the ssn compatible with 'Ssnip' type Ssnfmt = PrintL 3 "%03d-%02d-%04d" Id +-- | \'ip\' type for reading in time type Hmsip = Map (ReadP Int Id) (Resplit ":" Id) --- type Hmsop' = BoolsQuick "" '[ Msg "hours:" (Between 0 23), Msg "minutes:" (Between 0 59), Msg "seconds:" (Between 0 59)] -type Hmsop' = Bools '[ '("hours", Between 0 23), '("minutes",Between 0 59), '("seconds",Between 0 59) ] -type Hmsop = GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)] +-- type Hmsop' = BoolsQuick "" '[ Msg "hours:" (Between 0 23 Id), Msg "minutes:" (Between 0 59 Id), Msg "seconds:" (Between 0 59 Id)] +-- | \'op\' type for validating the time using a guard +type Hmsop = GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)] + +-- | \'op\' type for validating the time using predicate +type Hmsop' = Bools '[ '("hours", Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ] + +-- | \'fmt\' type for formatting the time type Hmsfmt = PrintL 3 "%02d:%02d:%02d" Id +-- | regular expression for a time component type HmsRE = "^([0-1][0-9]|2[0-3]):([0-5][0-9]):([0-5][0-9])$" -- strict validation should only be done in 'op' not 'ip' +-- | regular expression for an ip4 address type Ip4RE = "^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$" +-- | \'ip\' type for reading in an ip4 address type Ip4ip = Map (ReadP Int Id) (Resplit "\\." Id) +-- | \'ip\' type for reading in an ip4 address using a regular expression type Ip4ip' = Map (ReadP Int Id) (Rescan Ip4RE Id >> Snd (OneP Id)) -- RepeatT is a type family so it expands everything! replace RepeatT with a type class -type Ip4op' = BoolsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255) -type Ip4op = GuardsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255) +-- | \'op\' type for validating an ip4 address using a predicate +type Ip4op' = BoolsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255 Id) +-- | \'op\' type for validating an ip4 address using a guard +type Ip4op = GuardsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255 Id) + +-- | \'fmt\' type for formatting an ip4 address type Ip4fmt = PrintL 4 "%03d.%03d.%03d.%03d" Id +-- | regular expression for an octet type OctetRE = "(25[0-5]|2[0..4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])" -- no padded numbers allowed ---type Ip4StrictRE = "^" `AppendSymbol` OctetRE `AppendSymbol` "\\." `AppendSymbol` OctetRE `AppendSymbol` "\\." `AppendSymbol` OctetRE `AppendSymbol` "\\." `AppendSymbol` OctetRE `AppendSymbol` "$" -type Ip4StrictRE = "^" `AppendSymbol` IntersperseT "\\." (RepeatT 4 OctetRE) `AppendSymbol` "$" +--type Ip4StrictRE = "^" <%> OctetRE <%> "\\." <%> OctetRE <%> "\\." <%> OctetRE <%> "\\." <%> OctetRE <%> "$" +-- | regular expression for an ip4 address +type Ip4StrictRE = "^" <%> IntersperseT "\\." (RepeatT 4 OctetRE) <%> "$" + +-- | \'ip\' type for reading in an ip6 address type Ip6ip = Resplit ":" Id >> Map (If (Id == "") "0" Id) Id - >> Map (ReadBaseInt 16 Id) Id + >> Map (ReadBase Int 16 Id) Id >> PadL 8 0 Id ---type Ip6ip' = Map (If (Id == "") 0 (ReadBaseInt 16 Id)) (Resplit ":" Id) >> PadL 8 0 Id +--type Ip6ip' = Map (If (Id == "") 0 (ReadBase Int 16 Id)) (Resplit ":" Id) >> PadL 8 0 Id +-- | \'op\' type for validating an ip6 address using predicates type Ip6op = Msg "count is bad:" (Len == 8) - && Msg "out of bounds:" (All (Between 0 65535) Id) + && Msg "out of bounds:" (All (Between 0 65535 Id) Id) +-- | \'fmt\' type for formatting an ip6 address type Ip6fmt = PrintL 8 "%04x:%04x:%04x:%04x:%04x:%04x:%04x:%04x" Id -- valid dates for for DateFmts are "2001-01-01" "Jan 24 2009" and "03/29/07" type DateFmts = '["%Y-%m-%d", "%m/%d/%y", "%B %d %Y"] +-- | \'ip\' type for reading one of many date formats from 'DateFmts' type DateNip = ParseTimes Day DateFmts Id type DateTimeFmts = '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"] +-- | \'ip\' type for reading one of many date time formats from 'DateTimeFmts' type DateTimeNip = ParseTimes UTCTime DateTimeFmts Id --- this works but ParseTimeP is easier +-- ParseTimeP is easier and accurate type DdmmyyyyRE = "^(\\d{2})-(\\d{2})-(\\d{4})$" -type Ddmmyyyyval' = GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050] -type Ddmmyyyyval = - Guards '[ '(PrintT "guard(%d) day %d is out of range" Id, Between 1 31) - , '(PrintT "guard(%d) month %d is out of range" Id, Between 1 12) - , '(PrintT "guard(%d) year %d is out of range" Id, Between 1990 2050) ] +{- +type Ddmmyyyyop = + Guards '[ '(PrintT "guard(%d) day %d is out of range" Id, Between 1 31 Id) + , '(PrintT "guard(%d) month %d is out of range" Id, Between 1 12 Id) + , '(PrintT "guard(%d) year %d is out of range" Id, Between 1990 2050 Id) ] +-} +--type Ddmmyyyyop' = GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id] +type Ddmmyyyyop = GuardsDetail "%s %d is out of range" '[ '("day", Between 1 31 Id), '("month", Between 1 12 Id), '("year", Between 1990 2050 Id) ] +type Ddmmyyyyop' = Bools '[ '("day", Between 1 31 Id), '("month", Between 1 12 Id), '("year", Between 1990 2050 Id) ] +--type Ddmmyyyyop'''' = BoolsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id] -type Luhn'' (n :: Nat) = +type Luhnop' (n :: Nat) = Guard (PrintT "incorrect number of digits found %d but expected %d in [%s]" '(Len, n, ShowP Id)) (Len == n) >> Do '[ Reverse ,Zip (Cycle n [1,2]) Id ,Map (Fst Id * Snd Id >> If (Id >= 10) (Id - 9) Id) Id - ,FoldMap (SG.Sum Int) Id + ,Sum ] >> Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0) +type Luhn'' (n :: Nat) = Luhnip >> Luhnop' n + type Luhn' (n :: Nat) = Msg "Luhn'" (Do '[Guard (PrintT "incorrect number of digits found %d but expected %d in [%s]" '(Len, n, Id)) (Len == n) @@ -171,7 +211,7 @@ ,Reverse ,Zip (Cycle n [1,2]) Id ,Map (Fst Id * Snd Id >> If (Id >= 10) (Id - 9) Id) Id - ,FoldMap (SG.Sum Int) Id + ,Sum ] ,Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0) ])
src/Predicate/Examples/Refined2.hs view
@@ -15,7 +15,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ConstraintKinds #-} {- | - Contains examples to use with "Predicate.Refined2" + Contains prepackaged 3-tuples to use with 'Refined2' -} module Predicate.Examples.Refined2 ( -- ** date time checkers @@ -33,6 +33,10 @@ , Hms , HmsR + , hms' + , Hms' + , HmsR' + -- ** credit cards , Ccn , cc11 @@ -136,10 +140,10 @@ -- Right (Refined2 {r2In = [134,1,2211], r2Out = "134-01-2211"}) -- -- >>> prtEval2 @Ssnip @Ssnop ol "666-01-2211" --- Left Step 2. False Boolean Check(op) | {Bools(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))} +-- Left Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))} -- -- >>> prtEval2 @Ssnip @Ssnop ol "667-00-2211" --- Left Step 2. False Boolean Check(op) | {Bools(1) [number for group 1 invalid: found 0] (1 <= 0)} +-- Left Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)} -- ssn :: Proxy Ssn @@ -155,10 +159,10 @@ -- Right (Refined2 {r2In = [23,13,59], r2Out = "23:13:59"}) -- -- >>> prtEval2 @Hmsip @Hmsop' ol "23:13:60" --- Left Step 2. False Boolean Check(op) | {Bools(2) [seconds] (60 <= 59)} +-- Left Step 2. False Boolean Check(op) | {Bool(2) [seconds] (60 <= 59)} -- -- >>> prtEval2 @Hmsip @Hmsop' ol "26:13:59" --- Left Step 2. False Boolean Check(op) | {Bools(0) [hours] (26 <= 23)} +-- Left Step 2. False Boolean Check(op) | {Bool(0) [hours] (26 <= 23)} -- hms :: Proxy Hms hms = mkProxy2' @@ -166,19 +170,25 @@ type HmsR = MakeR2 Hms type Hms = '(Hmsip, Hmsop >> 'True, String) +hms' :: Proxy Hms' +hms' = mkProxy2' + +type HmsR' = MakeR2 Hms' +type Hms' = '(Hmsip, Hmsop', String) + -- | read in an ipv4 address and validate it -- -- >>> prtEval2 @Ip4ip @Ip4op' oz "001.223.14.1" -- Right (Refined2 {r2In = [1,223,14,1], r2Out = "001.223.14.1"}) -- -- >>> prtEval2 @Ip4ip @Ip4op' ol "001.223.14.999" --- Left Step 2. False Boolean Check(op) | {Bools(3) [octet 3 out of range 0-255 found 999] (999 <= 255)} +-- Left Step 2. False Boolean Check(op) | {Bool(3) [octet 3 out of range 0-255 found 999] (999 <= 255)} -- -- >>> prtEval2P ip4 ol "001.223.14.999" -- Left Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999 -- -- >>> prtEval2P ip4 ol "001.223.14.999.1" --- Left Step 2. Failed Boolean Check(op) | Guards: invalid length:expected 4 but found 5 +-- Left Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4 -- -- >>> prtEval2P ip4 ol "001.257.14.1" -- Left Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257 @@ -189,7 +199,7 @@ ip4 :: Proxy Ip4 ip4 = Proxy -type Ip4R' = MakeR2 Ip4 +type Ip4R' = MakeR2 Ip4' type Ip4' = '(Ip4ip, Ip4op', String) -- boolean predicates ip4' :: Proxy Ip4' @@ -207,16 +217,16 @@ -- | convert a string from a given base \'i\' and store it internally as an base 10 integer -- --- >>> prtEval2 @(ReadBaseInt 16 Id) @'True oz "00fe" +-- >>> prtEval2 @(ReadBase Int 16 Id) @'True oz "00fe" -- Right (Refined2 {r2In = 254, r2Out = "00fe"}) -- --- >>> prtEval2 @(ReadBaseInt 16 Id) @(Between 100 400) oz "00fe" +-- >>> prtEval2 @(ReadBase Int 16 Id) @(Between 100 400 Id) oz "00fe" -- Right (Refined2 {r2In = 254, r2Out = "00fe"}) -- --- >>> prtEval2 @(ReadBaseInt 16 Id) @(GuardSimple (Id < 400) >> 'True) oz "f0fe" +-- >>> prtEval2 @(ReadBase Int 16 Id) @(GuardSimple (Id < 400) >> 'True) oz "f0fe" -- Left Step 2. Failed Boolean Check(op) | (61694 < 400) -- --- >>> prtEval2 @(ReadBaseInt 16 Id) @(Id < 400) ol "f0fe" -- todo: why different parens vs braces +-- >>> prtEval2 @(ReadBase Int 16 Id) @(Id < 400) ol "f0fe" -- todo: why different parens vs braces -- Left Step 2. False Boolean Check(op) | {61694 < 400} -- type BaseN (n :: Nat) = BaseN' n 'True @@ -258,10 +268,10 @@ -- >>> prtEval2 @(ReadP Rational Id) @'True oz "13x % 3" -- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3) -- --- >>> prtEval2 @(ReadP Rational Id) @(Between (3 % 1) (5 % 1)) oz "13 % 3" +-- >>> prtEval2 @(ReadP Rational Id) @(3 % 1 <..> 5 % 1) oz "13 % 3" -- Right (Refined2 {r2In = 13 % 3, r2Out = "13 % 3"}) -- --- >>> prtEval2 @(ReadP Rational Id) @(Between (11 -% 2) (3 -% 1)) oz "-13 % 3" +-- >>> prtEval2 @(ReadP Rational Id) @(11 -% 2 <..> 3 -% 1) oz "-13 % 3" -- Right (Refined2 {r2In = (-13) % 3, r2Out = "-13 % 3"}) -- -- >>> prtEval2 @(ReadP Rational Id) @(Id > (15 % 1)) oz "13 % 3"
src/Predicate/Examples/Refined3.hs view
@@ -15,7 +15,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ConstraintKinds #-} {- | - Contains prepackaged 4-tuples to use with 'Refined3' + Contains prepackaged 4-tuples and proxies to use with 'Refined3' -} module Predicate.Examples.Refined3 ( -- ** date time checkers @@ -33,6 +33,10 @@ , Hms , HmsR + , hms' + , Hms' + , HmsR' + -- ** credit cards , ccn , ccn' @@ -169,10 +173,10 @@ -- Right (Refined3 {r3In = [134,1,2211], r3Out = "134-01-2211"}) -- -- >>> prtEval3P ssn ol "666-01-2211" --- Left Step 2. False Boolean Check(op) | {Bools(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))} +-- Left Step 2. False Boolean Check(op) | {Bool(0) [number for group 0 invalid: found 666] (True && False | (666 /= 666))} -- -- >>> prtEval3P ssn ol "667-00-2211" --- Left Step 2. False Boolean Check(op) | {Bools(1) [number for group 1 invalid: found 0] (1 <= 0)} +-- Left Step 2. False Boolean Check(op) | {Bool(1) [number for group 1 invalid: found 0] (1 <= 0)} -- type Ssn = '(Ssnip, Ssnop, Ssnfmt, String) type SsnR = MakeR3 Ssn @@ -194,6 +198,15 @@ type Hms = '(Hmsip, Hmsop >> 'True, Hmsfmt, String) + +hms' :: Proxy Hms' +hms' = mkProxy3' + +type HmsR' = MakeR3 Hms' + +type Hms' = '(Hmsip, Hmsop', Hmsfmt, String) + + -- | read in an ipv4 address and validate it -- -- >>> prtEval3P ip4 oz "001.223.14.1" @@ -203,7 +216,7 @@ -- Left Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 999 -- -- >>> prtEval3P ip4 oz "001.223.14.999.1" --- Left Step 2. Failed Boolean Check(op) | Guards: invalid length:expected 4 but found 5 +-- Left Step 2. Failed Boolean Check(op) | Guards:invalid length(5) expected 4 -- -- >>> prtEval3P ip4 ol "001.257.14.1" -- Left Step 2. Failed Boolean Check(op) | octet 1 out of range 0-255 found 257 @@ -238,7 +251,7 @@ -- >>> prtEval3P base16 oz "00fe" -- Right (Refined3 {r3In = 254, r3Out = "fe"}) -- --- >>> prtEval3P (basen' @16 @(Between 100 400)) oz "00fe" +-- >>> prtEval3P (basen' @16 @(100 <..> 400)) oz "00fe" -- Right (Refined3 {r3In = 254, r3Out = "fe"}) -- -- >>> prtEval3P (basen' @16 @(GuardSimple (Id < 400) >> 'True)) oz "f0fe" @@ -313,8 +326,8 @@ between :: Proxy (BetweenN m n) between = mkProxy3 -type BetweenN m n = '(Id, Between m n, Id, Int) -type BetweenR m n = RefinedEmulate (Between m n) Int +type BetweenN m n = '(Id, Between m n Id, Id, Int) +type BetweenR m n = RefinedEmulate (Between m n Id) Int type LuhnR (n :: Nat) = MakeR3 (LuhnT n) @@ -371,10 +384,10 @@ -- >>> prtEval3P (readshow @Rational) oz "13x % 3" -- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3) -- --- >>> prtEval3P (readshow' @Rational @(Between (3 % 1) (5 % 1))) oz "13 % 3" +-- >>> prtEval3P (readshow' @Rational @(3 % 1 <..> 5 % 1)) oz "13 % 3" -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"}) -- --- >>> prtEval3P (Proxy @(ReadShow' Rational (Between (11 -% 2) (3 -% 1)))) oz "-13 % 3" +-- >>> prtEval3P (Proxy @(ReadShow' Rational (11 -% 2 <..> 3 -% 1))) oz "-13 % 3" -- Right (Refined3 {r3In = (-13) % 3, r3Out = "(-13) % 3"}) -- -- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (15 % 1)))) oz "13 % 3"
src/Predicate/Prelude.hs view
@@ -1,8 +1,10 @@--- no types referring to types! else lose use of _ as Type +-- the mkNode opts (FailT msg) [msg] .. -- repetitive: needs to add value +-- no types referring to types otherwise we lose use of _ as Type {-# OPTIONS -Wall #-} {-# OPTIONS -Wcompat #-} {-# OPTIONS -Wincomplete-record-updates #-} {-# OPTIONS -Wincomplete-uni-patterns #-} +{-# OPTIONS -Wredundant-constraints #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} @@ -41,13 +43,16 @@ , Desc' , Between , type (<..>) - , Between' , All , Any , AllPositive , Positive , AllNegative , Negative + , AndA + , type (&*) + , OrA + , type (|+) -- ** regex expressions , Re @@ -160,7 +165,6 @@ , ReadMaybe' , ReadBase , ReadBase' - , ReadBaseInt , ShowBase -- ** aeson expressions @@ -436,6 +440,8 @@ , Stdout , Stderr , Stdin + , ReadIO + , ReadIO' -- ** string expressions , ToLower @@ -495,6 +501,7 @@ , type (|>) , type (>|) , type (>|>) + , Uncurry -- *** parallel expressions , Para @@ -588,7 +595,7 @@ instance P AscT x => P Asc x where type PP Asc x = PP AscT x - eval _ = eval (Proxy @AscT) + eval _ = evalBool (Proxy @AscT) -- | a type level predicate for a strictly increasing list data Asc' @@ -596,7 +603,7 @@ instance P AscT' x => P Asc' x where type PP Asc' x = PP AscT' x - eval _ = eval (Proxy @AscT') + eval _ = evalBool (Proxy @AscT') -- | a type level predicate for a monotonic decreasing list data Desc @@ -604,14 +611,14 @@ instance P DescT x => P Desc x where type PP Desc x = PP DescT x - eval _ = eval (Proxy @DescT) + eval _ = evalBool (Proxy @DescT) -- | a type level predicate for a strictly decreasing list data Desc' type DescT' = All (Fst Id > Snd Id) Pairs instance P DescT' x => P Desc' x where type PP Desc' x = PP DescT' x - eval _ = eval (Proxy @DescT') + eval _ = evalBool (Proxy @DescT') --type AscAlt = SortOn Id Id == Id @@ -619,15 +626,15 @@ -- | A predicate that determines if the value is between \'p\' and \'q\' -- --- >>> pz @(Between' 5 8 Len) [1,2,3,4,5,5,7] +-- >>> pz @(Between 5 8 Len) [1,2,3,4,5,5,7] -- True -- TrueT -- --- >>> pz @(Between 5 8) 6 +-- >>> pz @(5 <..> 8) 6 -- True -- TrueT -- --- >>> pl @(Between 5 8) 9 +-- >>> pl @(Between 5 8 Id) 9 -- False (9 <= 8) -- FalseT -- @@ -639,7 +646,7 @@ -- False -- FalseT -- -data Between' p q r -- reify as it is used a lot! nicer specific messages at the top level! +data Between p q r -- reify as it is used a lot! nicer specific messages at the top level! instance (Ord (PP p x) , Show (PP p x) @@ -648,8 +655,8 @@ , P p x , P q x , P r x - ) => P (Between' p q r) x where - type PP (Between' p q r) x = Bool + ) => P (Between p q r) x where + type PP (Between p q r) x = Bool eval _ opts x = do let msg0 = "Between" rr <- eval (Proxy @r) opts x @@ -665,25 +672,19 @@ else if p > r then mkNodeB opts False [show p <> " <= " <> show r] hhs else mkNodeB opts False [show r <> " <= " <> show q] hhs -data Between p q -type BetweenT p q = Between' p q Id -instance P (BetweenT p q) x => P (Between p q) x where - type PP (Between p q) x = PP (BetweenT p q) x - eval _ = eval (Proxy @(BetweenT p q)) - data p <..> q infix 4 <..> -type BetweenTT p q = Between p q +type BetweenT p q = Between p q Id -instance P (BetweenTT p q) x => P (p <..> q) x where - type PP (p <..> q) x = PP (BetweenTT p q) x - eval _ = eval (Proxy @(BetweenTT p q)) +instance P (BetweenT p q) x => P (p <..> q) x where + type PP (p <..> q) x = PP (BetweenT p q) x + eval _ = evalBool (Proxy @(BetweenT p q)) -- | similar to 'all' -- --- >>> pl @(All (Between 1 8) Id) [7,3,4,1,2,9,0,1] +-- >>> pl @(All (Between 1 8 Id) Id) [7,3,4,1,2,9,0,1] -- False (All(8) i=5 (9 <= 8)) -- FalseT -- @@ -766,7 +767,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case chkSize opts msg0 q [hh qq] of Left e -> pure e Right () -> do @@ -818,7 +819,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case chkSize opts msg0 q [hh qq] of Left e -> pure e Right () -> do @@ -857,7 +858,7 @@ instance P AllPositiveT x => P AllPositive x where type PP AllPositive x = PP AllPositiveT x - eval _ = eval (Proxy @AllPositiveT) + eval _ = evalBool (Proxy @AllPositiveT) -- | a type level predicate for all negative elements in a list data AllNegative @@ -865,7 +866,7 @@ instance P AllNegativeT x => P AllNegative x where type PP AllNegative x = PP AllNegativeT x - eval _ = eval (Proxy @AllNegativeT) + eval _ = evalBool (Proxy @AllNegativeT) type Positive = Gt 0 @@ -909,12 +910,7 @@ -- data Re' (rs :: [ROpt]) p q data Re p q -type ReT p q = Re' '[] p q -instance P (ReT p q) x => P (Re p q) x where - type PP (Re p q) x = PP (ReT p q) x - eval _ = eval (Proxy @(ReT p q)) - instance (GetROpts rs , PP p x ~ String , PP q x ~ String @@ -937,6 +933,12 @@ let b = q RH.=~ regex in mkNodeB opts b [msg1 <> showLit1 opts " | " q] hhs +type ReT p q = Re' '[] p q + +instance P (ReT p q) x => P (Re p q) x where + type PP (Re p q) x = PP (ReT p q) x + eval _ = evalBool (Proxy @(ReT p q)) + -- only way with rescan is to be explicit: no repeats! and useanchors but not (?m) -- or just use Re' but then we only get a bool ie doesnt capture groups -- rescan returns Right [] as an failure! @@ -954,14 +956,7 @@ -- PresentT [("13:05:25",["13","05","25"])] -- data Rescan' (rs :: [ROpt]) p q -data Rescan p q -type RescanT p q = Rescan' '[] p q -instance P (RescanT p q) x => P (Rescan p q) x where - type PP (Rescan p q) x = PP (RescanT p q) x - eval _ = eval (Proxy @(RescanT p q)) - - instance (GetROpts rs , PP p x ~ String , PP q x ~ String @@ -987,7 +982,14 @@ mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] [hh pp, hh qq] (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] [hh pp, hh qq] +data Rescan p q +type RescanT p q = Rescan' '[] p q +instance P (RescanT p q) x => P (Rescan p q) x where + type PP (Rescan p q) x = PP (RescanT p q) x + eval _ = eval (Proxy @(RescanT p q)) + + -- | 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" @@ -996,14 +998,6 @@ -- data RescanRanges' (rs :: [ROpt]) p q -data RescanRanges p q -type RescanRangesT p q = RescanRanges' '[] p q - -instance P (RescanRangesT p q) x => P (RescanRanges p q) x where - type PP (RescanRanges p q) x = PP (RescanRangesT p q) x - eval _ = eval (Proxy @(RescanRangesT p q)) - - instance (GetROpts rs , PP p x ~ String , PP q x ~ String @@ -1029,6 +1023,13 @@ mkNode opts (FailT "Regex no results") [msg1 <> " no match" <> show1 opts " | " q] hhs (b, _) -> mkNode opts (PresentT b) [lit01 opts msg1 b q] hhs +data RescanRanges p q +type RescanRangesT p q = RescanRanges' '[] p q + +instance P (RescanRangesT p q) x => P (RescanRanges p q) x where + type PP (RescanRanges p q) x = PP (RescanRangesT p q) x + eval _ = eval (Proxy @(RescanRangesT p q)) + -- | splits a string on a regex delimiter -- -- >>> pz @(Resplit "\\." Id) "141.201.1.22" @@ -1317,6 +1318,22 @@ -- False -- FalseT -- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "AbcdE" +-- False ((>>) False | {True (&*) False | (IsLower | "bcdE")}) +-- FalseT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "Abcde" +-- True ((>>) True | {True (&*) True}) +-- TrueT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "xbcde" +-- False ((>>) False | {IsUpper | "x"})}) +-- FalseT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "X" +-- True ((>>) True | {True (&*) True}) +-- TrueT +-- instance (GetCharSet cs , Show a , TL.IsText a @@ -1324,7 +1341,7 @@ type PP (IsCharSet cs) a = Bool eval _ opts as = let b = allOf TL.text f as - msg0 = "IsCharSet " ++ show cs + msg0 = "Is" ++ drop 1 (show cs) (cs,f) = getCharSet @cs in pure $ mkNodeB opts b [msg0 <> show1 opts " | " as] [] @@ -1368,14 +1385,14 @@ instance P IsLowerT x => P IsLower x where type PP IsLower x = PP IsLowerT x - eval _ = eval (Proxy @IsLowerT) + eval _ = evalBool (Proxy @IsLowerT) data IsUpper type IsUpperT = IsCharSet 'CUpper instance P IsUpperT x => P IsUpper x where type PP IsUpper x = PP IsUpperT x - eval _ = eval (Proxy @IsUpperT) + eval _ = evalBool (Proxy @IsUpperT) -- | predicate for determining if the string is all digits -- @@ -1391,49 +1408,49 @@ type IsNumberT = IsCharSet 'CNumber instance P IsNumberT x => P IsNumber x where type PP IsNumber x = PP IsNumberT x - eval _ = eval (Proxy @IsNumberT) + eval _ = evalBool (Proxy @IsNumberT) data IsSpace type IsSpaceT = IsCharSet 'CSpace instance P IsSpaceT x => P IsSpace x where type PP IsSpace x = PP IsSpaceT x - eval _ = eval (Proxy @IsSpaceT) + eval _ = evalBool (Proxy @IsSpaceT) data IsPunctuation type IsPunctuationT = IsCharSet 'CPunctuation instance P IsPunctuationT x => P IsPunctuation x where type PP IsPunctuation x = PP IsPunctuationT x - eval _ = eval (Proxy @IsPunctuationT) + eval _ = evalBool (Proxy @IsPunctuationT) data IsControl type IsControlT = IsCharSet 'CControl instance P IsControlT x => P IsControl x where type PP IsControl x = PP IsControlT x - eval _ = eval (Proxy @IsControlT) + eval _ = evalBool (Proxy @IsControlT) data IsHexDigit type IsHexDigitT = IsCharSet 'CHexDigit instance P IsHexDigitT x => P IsHexDigit x where type PP IsHexDigit x = PP IsHexDigitT x - eval _ = eval (Proxy @IsHexDigitT) + eval _ = evalBool (Proxy @IsHexDigitT) data IsOctDigit type IsOctDigitT = IsCharSet 'COctDigit instance P IsOctDigitT x => P IsOctDigit x where type PP IsOctDigit x = PP IsOctDigitT x - eval _ = eval (Proxy @IsOctDigitT) + eval _ = evalBool (Proxy @IsOctDigitT) data IsSeparator type IsSeparatorT = IsCharSet 'CSeparator instance P IsSeparatorT x => P IsSeparator x where type PP IsSeparator x = PP IsSeparatorT x - eval _ = eval (Proxy @IsSeparatorT) + eval _ = evalBool (Proxy @IsSeparatorT) data IsLatin1 type IsLatin1T = IsCharSet 'CLatin1 instance P IsLatin1T x => P IsLatin1 x where type PP IsLatin1 x = PP IsLatin1T x - eval _ = eval (Proxy @IsLatin1T) + eval _ = evalBool (Proxy @IsLatin1T) -- | converts a string 'Data.Text.Lens.IsText' value to lower case @@ -1749,11 +1766,11 @@ -- Present 4 % 5 -- PresentT (4 % 5) -- --- >>> pz @(ReadP Day Id >> Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30")) "2018-10-12" +-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2018-10-12" -- True -- TrueT -- --- >>> pz @(ReadP Day Id >> Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30")) "2016-10-12" +-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2016-10-12" -- False -- FalseT -- @@ -1977,7 +1994,7 @@ rhs <- ff (map snd rr') case getValueLR opts msg0 rhs [] of Left _ -> pure rhs - Right rr -> do + Right rr -> pure $ mkNode opts (PresentT (ll ++ w : rr)) [msg0 <> show0 opts " lhs=" ll <> " pivot " <> show w <> show0 opts " rhs=" rr] (hh pp : [hh lhs | length ll > 1] ++ [hh rhs | length rr > 1]) @@ -2471,7 +2488,7 @@ pure $ case getValueLR opts msg0 pp [] of Left e -> e Right a -> - let r = (toRational a) + let r = toRational a in mkNode opts (PresentT r) [show01 opts msg0 r a] [hh pp] -- | 'fromRational' function where you need to provide the type \'t\' of the result @@ -2739,7 +2756,7 @@ diff = if n<=l then 0 else n-l bs = if lft then (replicate diff p) <> q - else q <> (replicate diff p) + else q <> replicate diff p in mkNode opts (PresentT bs) [show01 opts msg1 bs q] (hhs <> [hh qq]) data PadL n p q @@ -2943,20 +2960,54 @@ let msg1 = msg0 ++ " Right" in mkNode opts (_tBool qq) [show01 opts msg1 a1 a] [hh qq] -data IsLeft -type IsLeftT = 'True ||| 'False +-- | similar to 'isLeft' +-- +-- >>> pz @(IsLeft Id) (Right 123) +-- False +-- FalseT +-- +-- >>> pz @(IsLeft Id) (Left 'a') +-- True +-- TrueT +-- +data IsLeft p -instance P IsLeftT x => P IsLeft x where - type PP IsLeft x = PP IsLeftT x - eval _ = eval (Proxy @IsLeftT) +instance (P p x, PP p x ~ Either a b) => P (IsLeft p) x where + type PP (IsLeft p) x = Bool + eval _ opts x = do + let msg0 = "IsLeft" + pp <- eval (Proxy @p) opts x + let hhs = [hh pp] + pure $ case getValueLR opts msg0 pp [] of + Left e -> e + Right (Left _) -> mkNodeB opts True [msg0] hhs + Right (Right _) -> mkNodeB opts False [msg0] hhs -data IsRight -type IsRightT = 'False ||| 'True +-- | similar to 'isRight' +-- +-- >>> pz @(IsRight Id) (Right 123) +-- True +-- TrueT +-- +-- >>> pz @(IsRight Id) (Left "aa") +-- False +-- FalseT +-- -instance P IsRightT x => P IsRight x where - type PP IsRight x = PP IsRightT x - eval _ = eval (Proxy @IsRightT) +data IsRight p +instance (P p x, PP p x ~ Either a b) => P (IsRight p) x where + type PP (IsRight p) x = Bool + eval _ opts x = do + let msg0 = "IsRight" + pp <- eval (Proxy @p) opts x + let hhs = [hh pp] + pure $ case getValueLR opts msg0 pp [] of + Left e -> e + Right (Left _) -> mkNodeB opts False [msg0] hhs + Right (Right _) -> mkNodeB opts True [msg0] hhs + + -- | similar 'Control.Arrow.+++' -- -- >>> pz @(Pred Id +++ Id) (Left 13) @@ -3037,42 +3088,42 @@ instance P (Cmp 'CGt p q) x => P (p > q) x where type PP (p > q) x = PP (Cmp 'CGt p q) x - eval _ = eval (Proxy @(Cmp 'CGt p q)) + eval _ = evalBool (Proxy @(Cmp 'CGt p q)) data p >= q infix 4 >= instance P (Cmp 'CGe p q) x => P (p >= q) x where type PP (p >= q) x = PP (Cmp 'CGe p q) x - eval _ = eval (Proxy @(Cmp 'CGe p q)) + eval _ = evalBool (Proxy @(Cmp 'CGe p q)) data p == q infix 4 == instance P (Cmp 'CEq p q) x => P (p == q) x where type PP (p == q) x = PP (Cmp 'CEq p q) x - eval _ = eval (Proxy @(Cmp 'CEq p q)) + eval _ = evalBool (Proxy @(Cmp 'CEq p q)) data p <= q infix 4 <= instance P (Cmp 'CLe p q) x => P (p <= q) x where type PP (p <= q) x = PP (Cmp 'CLe p q) x - eval _ = eval (Proxy @(Cmp 'CLe p q)) + eval _ = evalBool (Proxy @(Cmp 'CLe p q)) data p < q infix 4 < instance P (Cmp 'CLt p q) x => P (p < q) x where type PP (p < q) x = PP (Cmp 'CLt p q) x - eval _ = eval (Proxy @(Cmp 'CLt p q)) + eval _ = evalBool (Proxy @(Cmp 'CLt p q)) data p /= q infix 4 /= instance P (Cmp 'CNe p q) x => P (p /= q) x where type PP (p /= q) x = PP (Cmp 'CNe p q) x - eval _ = eval (Proxy @(Cmp 'CNe p q)) + eval _ = evalBool (Proxy @(Cmp 'CNe p q)) --type p + q = Bin 'BAdd p q --type p - q = Bin 'BSub p q @@ -3104,42 +3155,42 @@ instance P (CmpI 'CGt p q) x => P (p >~ q) x where type PP (p >~ q) x = PP (CmpI 'CGt p q) x - eval _ = eval (Proxy @(CmpI 'CGt p q)) + eval _ = evalBool (Proxy @(CmpI 'CGt p q)) data p >=~ q infix 4 >=~ instance P (CmpI 'CGe p q) x => P (p >=~ q) x where type PP (p >=~ q) x = PP (CmpI 'CGe p q) x - eval _ = eval (Proxy @(CmpI 'CGe p q)) + eval _ = evalBool (Proxy @(CmpI 'CGe p q)) data p ==~ q infix 4 ==~ instance P (CmpI 'CEq p q) x => P (p ==~ q) x where type PP (p ==~ q) x = PP (CmpI 'CEq p q) x - eval _ = eval (Proxy @(CmpI 'CEq p q)) + eval _ = evalBool (Proxy @(CmpI 'CEq p q)) data p <=~ q infix 4 <=~ instance P (CmpI 'CLe p q) x => P (p <=~ q) x where type PP (p <=~ q) x = PP (CmpI 'CLe p q) x - eval _ = eval (Proxy @(CmpI 'CLe p q)) + eval _ = evalBool (Proxy @(CmpI 'CLe p q)) data p <~ q infix 4 <~ instance P (CmpI 'CLt p q) x => P (p <~ q) x where type PP (p <~ q) x = PP (CmpI 'CLt p q) x - eval _ = eval (Proxy @(CmpI 'CLt p q)) + eval _ = evalBool (Proxy @(CmpI 'CLt p q)) data p /=~ q infix 4 /=~ instance P (CmpI 'CNe p q) x => P (p /=~ q) x where type PP (p /=~ q) x = PP (CmpI 'CNe p q) x - eval _ = eval (Proxy @(CmpI 'CNe p q)) + eval _ = evalBool (Proxy @(CmpI 'CNe p q)) class GetBinOp (k :: BinOp) where @@ -3233,8 +3284,8 @@ -- PresentT (13 % 2) -- -- >>> pz @(13 % Id) 0 --- Error MkRatio zero denominator --- FailT "MkRatio zero denominator" +-- Error (%) zero denominator +-- FailT "(%) zero denominator" -- -- >>> pz @(4 % 3 + 5 % 7) "asfd" -- Present 43 % 21 @@ -3279,13 +3330,6 @@ data p % q infixl 8 % -data p -% q -- = Negate (p % q) -infixl 8 -% - -instance P (Negate (p % q)) x => P (p -% q) x where - type PP (p -% q) x = PP (Negate (p % q)) x - eval _ = eval (Proxy @(Negate (p % q))) - instance (Integral (PP p x) , Integral (PP q x) , Eq (PP q x) @@ -3296,7 +3340,7 @@ ) => P (p % q) x where type PP (p % q) x = Rational eval _ opts x = do - let msg0 = "MkRatio" + let msg0 = "(%)" lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts x [] pure $ case lr of Left e -> e @@ -3307,7 +3351,15 @@ let d = fromIntegral p % fromIntegral q in mkNode opts (PresentT d) [show p <> " % " <> show q <> " = " <> show d] [hh pp, hh qq] +data p -% q -- = Negate (p % q) +infixl 8 -% +type NegateRatioT p q = Negate (p % q) +instance P (NegateRatioT p q) x => P (p -% q) x where + type PP (p -% q) x = PP (NegateRatioT p q) x + eval _ = eval (Proxy @(NegateRatioT p q)) + + -- | similar to 'negate' -- -- >>> pz @(Negate Id) 14 @@ -3780,16 +3832,6 @@ -- Error Succ bounded -- FailT "Succ bounded" -- -data SuccB p q - -data SuccB' q -type SuccBT' q = SuccB (Failp "Succ bounded") q - -instance P (SuccBT' q) x => P (SuccB' q) x where - type PP (SuccB' q) x = PP (SuccBT' q) x - eval _ = eval (Proxy @(SuccBT' q)) - - instance (PP q x ~ a , P q x , P p (Proxy a) @@ -3805,7 +3847,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case succMay q of Nothing -> do let msg1 = msg0 <> " out of range" @@ -3815,6 +3857,15 @@ Right _ -> mkNode opts (_tBool pp) [msg1] [hh qq, hh pp] Just n -> pure $ mkNode opts (PresentT n) [show01 opts msg0 n q] [hh qq] +data SuccB p q + +data SuccB' q +type SuccBT' q = SuccB (Failp "Succ bounded") q + +instance P (SuccBT' q) x => P (SuccB' q) x where + type PP (SuccB' q) x = PP (SuccBT' q) x + eval _ = eval (Proxy @(SuccBT' q)) + -- | bounded 'pred' function -- -- >>> pz @(PredB' Id) (13 :: Int) @@ -3825,16 +3876,9 @@ -- Error Pred bounded -- FailT "Pred bounded" -- -data PredB p q - data PredB' q type PredBT' q = PredB (Failp "Pred bounded") q -instance P (PredBT' q) x => P (PredB' q) x where - type PP (PredB' q) x = PP (PredBT' q) x - eval _ = eval (Proxy @(PredBT' q)) - - instance (PP q x ~ a , P q x , P p (Proxy a) @@ -3850,7 +3894,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case predMay q of Nothing -> do let msg1 = msg0 <> " out of range" @@ -3925,7 +3969,13 @@ Left e -> mkNode opts (FailT (msg0 <> " " <> e)) [msg0 <> show0 opts " " p] [hh pp] Right n -> mkNode opts (PresentT n) [show01 opts msg0 n p] [hh pp] +data PredB p q +instance P (PredBT' q) x => P (PredB' q) x where + type PP (PredB' q) x = PP (PredBT' q) x + eval _ = eval (Proxy @(PredBT' q)) + + -- | 'fromEnum' function -- -- >>> pz @(FromEnum Id) 'x' @@ -3998,7 +4048,7 @@ data ToEnumBDef' t def instance (P def (Proxy (PP t a)) - , PP def (Proxy (PP t a)) ~ (PP t a) + , PP def (Proxy (PP t a)) ~ PP t a , Show a , Show (PP t a) , Bounded (PP t a) @@ -4511,19 +4561,51 @@ Left e -> e Right b -> mkNode opts (_tBool qq) [show01 opts msg1 b a] [hh qq] -data IsNothing -type IsNothingT = MaybeIn 'True 'False +-- | similar to 'isJust' +-- +-- >>> pz @(IsJust Id) Nothing +-- False +-- FalseT +-- +-- >>> pz @(IsJust Id) (Just 'a') +-- True +-- TrueT +-- +data IsJust p -instance P IsNothingT x => P IsNothing x where - type PP IsNothing x = PP IsNothingT x - eval _ = eval (Proxy @IsNothingT) +instance (P p x, PP p x ~ Maybe a) => P (IsJust p) x where + type PP (IsJust p) x = Bool + eval _ opts x = do + let msg0 = "IsJust" + pp <- eval (Proxy @p) opts x + let hhs = [hh pp] + pure $ case getValueLR opts msg0 pp [] of + Left e -> e + Right (Just _) -> mkNodeB opts True [msg0] hhs + Right Nothing -> mkNodeB opts False [msg0] hhs -data IsJust -type IsJustT = MaybeIn 'False 'True +-- | similar to 'isNothing' +-- +-- >>> pz @(IsNothing Id) (Just 123) +-- False +-- FalseT +-- +-- >>> pz @(IsNothing Id) Nothing +-- True +-- TrueT +-- +data IsNothing p -instance P IsJustT x => P IsJust x where - type PP IsJust x = PP IsJustT x - eval _ = eval (Proxy @IsJustT) +instance (P p x, PP p x ~ Maybe a) => P (IsNothing p) x where + type PP (IsNothing p) x = Bool + eval _ opts x = do + let msg0 = "IsNothing" + pp <- eval (Proxy @p) opts x + let hhs = [hh pp] + pure $ case getValueLR opts msg0 pp [] of + Left e -> e + Right (Just _) -> mkNodeB opts False [msg0] hhs + Right Nothing -> mkNodeB opts True [msg0] hhs data MapMaybe p q type MapMaybeT p q = ConcatMap (p >> MaybeIn MEmptyP '[Id]) q @@ -4934,7 +5016,7 @@ instance (Show a , Show (t [a]) - , PP p x ~ (t [a]) + , PP p x ~ t [a] , P p x , Foldable t ) => P (Concat p) x where @@ -4958,7 +5040,7 @@ instance (Show a , Show (t a) - , PP p x ~ (t a) + , PP p x ~ t a , P p x , Integral (PP n x) , P n x @@ -4981,16 +5063,15 @@ data ProxyT' t -instance Typeable t => P (ProxyT' (t :: Type)) a where - type PP (ProxyT' t) a = Proxy (PP t a) +instance P (ProxyT' t) x where + type PP (ProxyT' t) x = Proxy (PP t x) eval _ opts _ = - let t = showT @t - in pure $ mkNode opts (PresentT Proxy) ["ProxyT(" <> show t ++ ")"] [] + pure $ mkNode opts (PresentT Proxy) ["ProxyT"] [] data ProxyT (t :: Type) type ProxyTT (t :: Type) = ProxyT' (Hole t) -instance P (ProxyTT t) x => P (ProxyT t) x where +instance P (ProxyT t) x where type PP (ProxyT t) x = PP (ProxyTT t) x eval _ = eval (Proxy @(ProxyTT t)) @@ -5014,7 +5095,7 @@ type PP (Ix n def) [a] = a eval _ opts as = do let n = nat @n - msg0 = "Ix " <> show n + msg0 = "Ix(" <> show n <> ")" case as ^? ix n of Nothing -> do let msg1 = msg0 <> " not found" @@ -5381,17 +5462,8 @@ type NullT = Null' Id instance P NullT a => P Null a where type PP Null a = PP NullT a - eval _ = eval (Proxy @NullT) -{- -instance (Show (t a) - , Foldable t - , t a ~ as - ) => P Null as where - type PP Null as = Bool - eval _ opts as = - let b = null as - in pure $ mkNodeB opts b ["Null" <> show1 opts " | " as] [] --} + eval _ = evalBool (Proxy @NullT) + -- | similar to 'enumFromTo' -- -- >>> pz @(EnumFromTo 2 5) () @@ -5527,7 +5599,7 @@ lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts z [] case lr of Left e -> pure e - Right (q,r,qq,rr) -> do + Right (q,r,qq,rr) -> case chkSize opts msg0 r [hh rr] of Left e -> pure e Right () -> do @@ -5544,7 +5616,7 @@ Right b' -> ff (i+1) b' as (rs ++ [((i,b), pp)]) (ts,lrx) :: ([((Int, b), TT b)], Either (TT [b]) ()) <- ff 1 q r [] pure $ case splitAndAlign opts [msg1] (((0,q), mkNode opts (PresentT q) [msg1 <> "(initial)"] []) : ts) of - Left _e -> errorInProgram "Scanl" + Left e -> errorInProgram $ "Scanl e=" ++ show (fromTT e) Right abcs -> let vals = map (view _1) abcs itts = map (view _2 &&& view _3) abcs @@ -5618,7 +5690,7 @@ Right w@(Just (_b,s')) -> ff (i+1) s' (rs ++ [((i,w), pp)]) (ts,lr) :: ([((Int, PP p s), TT (PP p s))], Either (TT [b]) ()) <- ff 1 q [] pure $ case splitAndAlign opts [msg1] ts of - Left _e -> errorInProgram "Unfoldr" + Left e -> errorInProgram $ "Unfoldr e=" ++ show (fromTT e) Right abcs -> let vals = map (view _1) abcs itts = map (view _2 &&& view _3) abcs @@ -5795,7 +5867,7 @@ qq <- eval (Proxy @q) opts a' case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case chkSize opts msg0 q [hh qq] of Left e -> pure e Right () -> do @@ -5840,7 +5912,7 @@ qq <- eval (Proxy @q) opts a' case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case chkSize opts msg0 q [hh qq] of Left e -> pure e Right () -> do @@ -5896,7 +5968,7 @@ pp <- eval (Proxy @prt) opts a pure $ case getValueLR opts msg0 pp [] of Left e -> e - Right s -> mkNode opts (FailT s) [msg0 <> " " <> s] (if isVerbose opts then [hh pp] else []) + Right s -> mkNode opts (FailT s) [msg0 <> " " <> s] [hh pp | isVerbose opts] data FailS p instance P (Fail I p) x => P (FailS p) x where @@ -5994,14 +6066,14 @@ instance P EvenT x => P Even x where type PP Even x = PP EvenT x - eval _ = eval (Proxy @EvenT) + eval _ = evalBool (Proxy @EvenT) data Odd type OddT = Mod I 2 == 1 instance P OddT x => P Odd x where type PP Odd x = PP OddT x - eval _ = eval (Proxy @OddT) + eval _ = evalBool (Proxy @OddT) --type Div' p q = Fst (DivMod p q) @@ -6201,8 +6273,8 @@ -- FailT "arg 2 failed with value 5" -- -- >>> pz @(GuardsQuick (PrintT "arg %d failed with value %d" Id) '[Gt 4, Ge 3, Same 4]) [17,3,5,99] --- Error Guards: invalid length:expected 3 but found 4 --- FailT "Guards: invalid length:expected 3 but found 4" +-- Error Guards:invalid length(4) expected 3 +-- FailT "Guards:invalid length(4) expected 3" -- data GuardsImpl (n :: Nat) (os :: [(k,k1)]) @@ -6214,20 +6286,20 @@ let msg0 = "Guards" n = getLen @ps if n /= length as then - --let msg1 = msg0 <> ": predicates(" <> show n <> ") /= data(" <> show (length as) <> ")" - let msg1 = msg0 <> ": invalid length:expected " ++ show n ++ " but found " ++ show (length as) + let msg1 = msg0 <> badLength as n in pure $ mkNode opts (FailT msg1) [msg1] [] else eval (Proxy @(GuardsImpl (LenT ps) ps)) opts as -instance (KnownNat n - , Show a - ) => P (GuardsImpl n ('[] :: [(k,k1)])) [a] where +badLength :: (Foldable t, Show n, Num n) => t a -> n -> String +badLength as n = ":invalid length(" <> show (length as) <> ") expected " ++ show (n+0) + +instance Show a + => P (GuardsImpl n ('[] :: [(k,k1)])) [a] where type PP (GuardsImpl n ('[] :: [(k,k1)])) [a] = [a] eval _ opts as = - let msg0 = "Guards" <> "(" <> show n <> ")" - n :: Int = nat @n + let msg0 = "Guards" in if not (null as) then errorInProgram $ "GuardsImpl base case has extra data " ++ show as - else pure $ mkNode opts (PresentT as) [msg0 <> " empty"] [] + else pure $ mkNode opts (PresentT as) [msg0 <> " no data"] [] instance (PP prt (Int, a) ~ String , P prt (Int, a) @@ -6242,7 +6314,7 @@ type PP (GuardsImpl n ('(prt,p) ': ps)) [a] = [a] eval _ opts as' = do let cpos = n-pos-1 - msgbase1 = "Guards" <> "(" <> show cpos <> ")" + msgbase1 = "Guard(" <> show cpos <> ")" msgbase2 = "Guards" n :: Int = nat @n pos = getLen @ps @@ -6255,8 +6327,8 @@ qq <- eval (Proxy @prt) opts (cpos,a) -- only run prt when predicate is False pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of Left e -> e - Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : if isVerbose opts then [hh qq] else []) - Right True -> do + Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : [hh qq | isVerbose opts]) + Right True -> if pos == 0 then -- we are at the bottom of the tree pure $ mkNode opts (PresentT [a]) [msgbase2] [hh pp] else do @@ -6264,11 +6336,7 @@ pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time! Right zs -> (ss & tForest %~ \x -> fromTT pp : x) & tBool .~ PresentT (a:zs) --- let tt = mkNode opts (PresentT (a:zs)) [msgbase1] [hh pp, hh ss] --- in if top then mkNode opts (PresentT (a:zs)) [msgbase2 <> "("++show n++") done!"] [hh tt] --- else tt - - _ -> errorInProgram $ "GuardsImpl n+1 case has no data" + _ -> errorInProgram "GuardsImpl n+1 case has no data" data GuardsQuick (prt :: k) (ps :: [k1]) type GuardsQuickT (prt :: k) (ps :: [k1]) = Guards (ToGuardsT prt ps) @@ -6279,42 +6347,44 @@ -- | 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), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,93,14] --- False (Bools(1) [mm] (93 <= 59)) +-- >>> 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), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,13,94] --- False (Bools(2) [<<<2 94>>>] (94 <= 59)) +-- >>> 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), '(W "mm",Between 0 59), '(PrintT "<<<%d %d>>>" Id,Between 0 59) ] ) [12,13,14] +-- >>> 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, Between 0 59, Between 0 59]) [12,13,14] +-- >>> 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, Between 0 59, Between 0 59]) [12,13,14] +-- >>> 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, Between 0 59, Between 0 59]) [12,13,99] --- False (Bools(2) [id=2 val=99] (99 <= 59)) +-- >>> 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), '("minutes",Between 0 59), '("seconds",Between 0 59) ] ) [12,13,14] +-- >>> 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), '("minutes",Between 0 59), '("seconds",Between 0 59) ] ) [12,60,14] --- False (Bools(1) [minutes] (60 <= 59)) +-- >>> 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), '("minutes",Between 0 59), '("seconds",Between 0 59) ] ) [12,60,14,20] --- False (Bools: invalid length:expected 3 but found 4) +-- >>> 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 -- data Bools (ps :: [(k,k1)]) @@ -6326,14 +6396,13 @@ type PP (Bools ps) [a] = Bool eval _ opts as = do let msg0 = "Bools" - msg1 = msg0 <> "("++show n++")" + msg1 = "Bool("++show n++")" n = getLen @ps case chkSize opts msg1 as [] of Left e -> pure e - Right () -> do + Right () -> if n /= length as then - let msg2 = msg0 <> ": invalid length:expected " ++ show n ++ " but found " ++ show (length as) - -- msg2 = predicates(" <> show n <> ") /= data(" <> show (length as) <> ")" + let msg2 = msg0 <> badLength as n in pure $ mkNodeB opts False [msg2] [] -- was FailT but now just FalseT else evalBool (Proxy @(BoolsImpl (LenT ps) ps)) opts as @@ -6344,7 +6413,7 @@ ) => P (BoolsImpl n ('[] :: [(k,k1)])) [a] where type PP (BoolsImpl n ('[] :: [(k,k1)])) [a] = Bool eval _ opts as = - let msg0 = "Bools(" <> show n <> ")" + let msg0 = "Bool(" <> show n <> ")" n :: Int = nat @n in if not (null as) then errorInProgram $ "BoolsImpl base case has extra data " ++ show as else pure $ mkNodeB opts True [msg0 <> " empty"] [] @@ -6362,7 +6431,7 @@ type PP (BoolsImpl n ('(prt,p) ': ps)) [a] = Bool eval _ opts as' = do let cpos = n-pos-1 - msgbase1 = "Bools(" <> showIndex cpos <> ")" + msgbase1 = "Bool(" <> showIndex cpos <> ")" msgbase2 = "Bools" n :: Int = nat @n pos = getLen @ps @@ -6375,8 +6444,8 @@ qq <- eval (Proxy @prt) opts (cpos,a) -- only run prt when predicate is False pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of Left e -> e - Right msgx -> mkNodeB opts False [msgbase1 <> " [" <> msgx <> "] " <> topMessage pp] (hh pp : if isVerbose opts then [hh qq] else []) - Right True -> do + Right msgx -> mkNodeB opts False [msgbase1 <> " [" <> msgx <> "] " <> topMessage pp] (hh pp : [hh qq | isVerbose opts]) + Right True -> if pos == 0 then -- we are at the bottom of the tree pure $ mkNodeB opts True [msgbase2] [hh pp] else do @@ -6384,58 +6453,60 @@ pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time! Right _ -> ss & tForest %~ \x -> fromTT pp : x - _ -> errorInProgram $ "BoolsImpl n+1 case has no data" + _ -> errorInProgram "BoolsImpl n+1 case has no data" data BoolsQuick (prt :: k) (ps :: [k1]) type BoolsQuickT (prt :: k) (ps :: [k1]) = Bools (ToGuardsT prt ps) -instance P (BoolsQuickT prt ps) x => P (BoolsQuick prt ps) x where +-- why do we need this? when BoolsN works without +instance (PP (Bools (ToGuardsT prt ps)) x ~ Bool + , P (BoolsQuickT prt ps) x + ) => P (BoolsQuick prt ps) x where type PP (BoolsQuick prt ps) x = PP (BoolsQuickT prt ps) x - eval _ = eval (Proxy @(BoolsQuickT prt ps)) + eval _ = evalBool (Proxy @(BoolsQuickT prt ps)) -- | 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)) [121,33,7,256] --- False (Bools(3) [id=3 must be between 0 and 255, found 256] (256 <= 255)) +-- >>> 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)) [121,33,7,44] +-- >>> 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 -- -data BoolsN prt (n :: Nat) p -type BoolsNT prt (n :: Nat) p = Bools (ToGuardsT prt (RepeatT n p)) +data BoolsN prt (n :: Nat) (p :: k1) +type BoolsNT prt (n :: Nat) (p :: k1) = Bools (ToGuardsT prt (RepeatT n p)) instance P (BoolsNT prt n p) [a] => P (BoolsN prt n p) [a] where type PP (BoolsN prt n p) [a] = PP (BoolsNT prt n p) [a] - eval _ = eval (Proxy @(BoolsNT prt n p)) + eval _ = evalBool (Proxy @(BoolsNT prt n p)) -- | if a predicate fails then then the corresponding symbol and value will be passed to the print function -- --- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [13,59,61] +-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [13,59,61] -- Error seconds invalid: found 61 -- FailT "seconds invalid: found 61" -- --- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [27,59,12] +-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [27,59,12] -- Error hours invalid: found 27 -- FailT "hours invalid: found 27" -- --- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)]) [23,59,12] +-- >>> pz @(GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]) [23,59,12] -- Present [23,59,12] -- PresentT [23,59,12] -- -data GuardsImplXX (ps :: [(k,k1)]) +data GuardsDetailImpl (ps :: [(k,k1)]) instance (GetLen ps , P (GuardsImplX (LenT ps) ps) [a] - ) => P (GuardsImplXX ps) [a] where - type PP (GuardsImplXX ps) [a] = PP (GuardsImplX (LenT ps) ps) [a] + ) => P (GuardsDetailImpl ps) [a] where + type PP (GuardsDetailImpl ps) [a] = PP (GuardsImplX (LenT ps) ps) [a] eval _ opts as = do let msg0 = "Guards" n = getLen @ps if n /= length as then - let msg1 = msg0 <> ": invalid length:expected " ++ show n ++ " but found " ++ show (length as) --- let msg1 = msg0 <> ": predicates(" <> show n <> ") /= data(" <> show (length as) <> ")" + let msg1 = msg0 <> badLength as n in pure $ mkNode opts (FailT msg1) [msg1] [] else eval (Proxy @(GuardsImplX (LenT ps) ps)) opts as @@ -6463,7 +6534,7 @@ type PP (GuardsImplX n ('(prt,p) ': ps)) [a] = [a] eval _ opts as' = do let cpos = n-pos-1 - msgbase1 = "Guard" <> "(" <> showIndex cpos <> ")" + msgbase1 = "Guard(" <> showIndex cpos <> ")" msgbase2 = "Guards" n :: Int = nat @n pos = getLen @ps @@ -6476,16 +6547,16 @@ qq <- eval (Proxy @prt) opts a -- only run prt when predicate is False pure $ case getValueLR opts (msgbase2 <> " False predicate and prt failed") qq [hh pp] of Left e -> e - Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : if isVerbose opts then [hh qq] else []) + Right msgx -> mkNode opts (FailT msgx) [msgbase1 <> " failed [" <> msgx <> "]" <> show0 opts " " a] (hh pp : [hh qq | isVerbose opts]) Right True -> do ss <- eval (Proxy @(GuardsImplX n ps)) opts as pure $ case getValueLRHide opts (msgbase1 <> " ok | rhs failed") ss [hh pp] of Left e -> e -- shortcut else we get too compounding errors with the pp tree being added each time! Right zs -> mkNode opts (PresentT (a:zs)) [msgbase1 <> show0 opts " " a] [hh pp, hh ss] - _ -> errorInProgram $ "GuardsImplX n+1 case has no data" + _ -> errorInProgram "GuardsImplX n+1 case has no data" -data GuardsDetail (prt :: Symbol) (ps :: [(k0,k1)]) -type GuardsDetailT (prt :: Symbol) (ps :: [(k0,k1)]) = GuardsImplXX (ToGuardsDetailT prt ps) +data GuardsDetail prt (ps :: [(k0,k1)]) +type GuardsDetailT prt (ps :: [(k0,k1)]) = GuardsDetailImpl (ToGuardsDetailT prt ps) instance P (GuardsDetailT prt ps) x => P (GuardsDetail prt ps) x where type PP (GuardsDetail prt ps) x = PP (GuardsDetailT prt ps) x @@ -6498,11 +6569,11 @@ -- | 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)) [121,33,7,256] +-- >>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,256] -- Error id=3 must be between 0 and 255, found 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)) [121,33,7,44] +-- >>> pz @(GuardsN (PrintT "id=%d must be between 0 and 255, found %d" Id) 4 (Between 0 255 Id)) [121,33,7,44] -- Present [121,33,7,44] -- PresentT [121,33,7,44] -- @@ -6552,7 +6623,7 @@ qq <- eval (Proxy @prt) opts a pure $ case getValueLR opts (msg0 <> " Msg") qq [hh pp] of Left e -> e - Right msgx -> mkNode opts (FailT msgx) [msg0 <> "(failed) [" <> msgx <> "]" <> show0 opts " | " a] (hh pp : if isVerbose opts then [hh qq] else []) + Right msgx -> mkNode opts (FailT msgx) [msg0 <> "(failed) [" <> msgx <> "]" <> show0 opts " | " a] (hh pp : [hh qq | isVerbose opts]) Right True -> pure $ mkNode opts (PresentT a) [msg0 <> "(ok)" <> show0 opts " | " a] [hh pp] -- dont show the guard message if successful @@ -6656,7 +6727,7 @@ eval _ opts a = do let msg0 = "(>>)" pp <- eval (Proxy @p) opts a - case getValueLRHide opts ("(>>) lhs failed") pp [] of + case getValueLRHide opts "(>>) lhs failed" pp [] of Left e -> pure e Right p -> do qq <- eval (Proxy @q) opts p @@ -6708,15 +6779,15 @@ type PP (p && q) a = Bool eval _ opts a = do let msg0 = "&&" - lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a [] + lr <- runPQBool msg0 (Proxy @p) (Proxy @q) opts a [] pure $ case lr of Left e -> e Right (p,q,pp,qq) -> let zz = case (p,q) of - (True,True) -> "" - (False,True) -> topMessage pp - (True,False) -> topMessage qq - (False,False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq + (True, True) -> "" + (False, True) -> topMessage pp + (True, False) -> topMessage qq + (False, False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq in mkNodeB opts (p&&q) [show p <> " " <> msg0 <> " " <> show q <> (if null zz then zz else " | " <> zz)] [hh pp, hh qq] -- | similar to 'Prelude.||' @@ -6740,7 +6811,7 @@ type PP (p || q) a = Bool eval _ opts a = do let msg0 = "||" - lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a [] + lr <- runPQBool msg0 (Proxy @p) (Proxy @q) opts a [] pure $ case lr of Left e -> e Right (p,q,pp,qq) -> @@ -6778,7 +6849,7 @@ type PP (p ~> q) a = Bool eval _ opts a = do let msg0 = "~>" - lr <- runPQ msg0 (Proxy @p) (Proxy @q) opts a [] + lr <- runPQBool msg0 (Proxy @p) (Proxy @q) opts a [] pure $ case lr of Left e -> e Right (p,q,pp,qq) -> @@ -6812,7 +6883,7 @@ type PP (Not p) x = Bool eval _ opts x = do let msg0 = "Not" - pp <- eval (Proxy @p) opts x + pp <- evalBool (Proxy @p) opts x pure $ case getValueLR opts msg0 pp [] of Left e -> e Right p -> @@ -6917,11 +6988,11 @@ -- True (1 < 4) -- TrueT -- --- >>> pl @(Between (Negate 7) 20) (-4) +-- >>> pl @(Negate 7 <..> 20) (-4) -- True (-7 <= -4 <= 20) -- TrueT -- --- >>> pl @(Between (Negate 7) 20) 21 +-- >>> pl @(Negate 7 <..> 20) 21 -- False (21 <= 20) -- FalseT -- @@ -7141,6 +7212,22 @@ -- True -- TrueT -- +-- >>> pl @(IsThat Id) (This 12) +-- False (IsThat | This 12) +-- FalseT +-- +-- >>> pl @(IsThis Id) (This 12) +-- True (IsThis | This 12) +-- TrueT +-- +-- >>> pl @(IsThese Id) (This 12) +-- False (IsThese | This 12) +-- FalseT +-- +-- >>> pl @(IsThese Id) (These 'x' 12) +-- True (IsThese | These 'x' 12) +-- TrueT +-- data IsTh (th :: These x y) p -- x y can be anything @@ -7153,35 +7240,35 @@ ) => P (IsTh (th :: These x1 x2) p) x where type PP (IsTh th p) x = Bool eval _ opts x = do - let msg0 = "IsTh" + let msg0 = "Is" pp <- eval (Proxy @p) opts x pure $ case getValueLR opts msg0 pp [] of Left e -> e Right p -> let (t,f) = getThese @th b = f p - in mkNodeB opts b [msg0 <> " " <> t <> show1 opts " | " p] [] + in mkNodeB opts b [msg0 <> t <> show1 opts " | " p] [] data IsThis p type IsThisT p = IsTh ('This '()) p instance P (IsThisT p) x => P (IsThis p) x where type PP (IsThis p) x = PP (IsThisT p) x - eval _ = eval (Proxy @(IsThisT p)) + eval _ = evalBool (Proxy @(IsThisT p)) data IsThat p type IsThatT p = IsTh ('That '()) p instance P (IsThatT p) x => P (IsThat p) x where type PP (IsThat p) x = PP (IsThatT p) x - eval _ = eval (Proxy @(IsThatT p)) + eval _ = evalBool (Proxy @(IsThatT p)) data IsThese p type IsTheseT p = IsTh ('These '() '()) p instance P (IsTheseT p) x => P (IsThese p) x where type PP (IsThese p) x = PP (IsTheseT p) x - eval _ = eval (Proxy @(IsTheseT p)) + eval _ = evalBool (Proxy @(IsTheseT p)) -- | similar to 'Data.These.these' -- @@ -7222,24 +7309,28 @@ , PP q b ~ PP r (a,b) ) => P (TheseIn p q r) (These a b) where type PP (TheseIn p q r) (These a b) = PP p a - eval _ opts = - \case + eval _ opts th = do + let msg0 = "TheseIn" + case th of This a -> do - let msg0 = "This" + let msg1 = "This " + msg2 = msg0 <> msg1 pp <- eval (Proxy @p) opts a - pure $ case getValueLR opts (msg0 <> " p failed") pp [] of + pure $ case getValueLR opts (msg2 <> "p failed") pp [] of Left e -> e - Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "This " a] [hh pp] + Right c -> mkNode opts (PresentT c) [show01' opts msg0 c msg1 a] [hh pp] That b -> do - let msg0 = "That" + let msg1 = "That " + msg2 = msg0 <> msg1 qq <- eval (Proxy @q) opts b - pure $ case getValueLR opts (msg0 <> " q failed") qq [] of + pure $ case getValueLR opts (msg2 <> "q failed") qq [] of Left e -> e - Right c -> mkNode opts (PresentT c) [show01' opts msg0 c "That " b] [hh qq] + Right c -> mkNode opts (PresentT c) [show01' opts msg0 c msg1 b] [hh qq] These a b -> do - let msg0 = "TheseIn" + let msg1 = "These " + msg2 = msg0 <> msg1 rr <- eval (Proxy @r) opts (a,b) - pure $ case getValueLR opts (msg0 <> " r failed") rr [] of + pure $ case getValueLR opts (msg2 <> "r failed") rr [] of Left e -> e Right c -> mkNode opts (PresentT c) [show01 opts msg0 c (These a b)] [hh rr] @@ -7686,13 +7777,6 @@ type PP (ReadBase t n p) x = PP (ReadBaseT t n p) x eval _ = eval (Proxy @(ReadBaseT t n p)) -data ReadBaseInt (n :: Nat) p -type ReadBaseIntT (n :: Nat) p = ReadBase' (Hole Int) n p - -instance P (ReadBaseIntT n p) x => P (ReadBaseInt n p) x where - type PP (ReadBaseInt n p) x = PP (ReadBaseIntT n p) x - eval _ = eval (Proxy @(ReadBaseIntT n p)) - getValidBase :: Int -> String getValidBase n = let xs = ['0'..'9'] <> ['a'..'z'] @@ -7732,7 +7816,7 @@ eval _ opts x = do let n = nat @n xs = getValidBase n - msg0 = "ShowBase " <> show n + msg0 = "ShowBase(" <> show n <> ")" pp <- eval (Proxy @p) opts x pure $ case getValueLR opts msg0 pp [] of Left e -> e @@ -7832,8 +7916,8 @@ -- PresentT [10,21,120] -- -- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30,40] --- Error Para: invalid length:expected 3 but found 4 --- FailT "Para: invalid length:expected 3 but found 4" +-- Error Para:invalid length(4) expected 3 +-- FailT "Para:invalid length(4) expected 3" -- data ParaImpl (n :: Nat) (os :: [k]) @@ -7846,8 +7930,7 @@ let msg0 = "Para" n = getLen @ps if n /= length as then --- let msg1 = msg0 <> ": predicates(" <> show n <> ") /= data(" <> show (length as) <> ")" - let msg1 = msg0 <> ": invalid length:expected " ++ show n ++ " but found " ++ show (length as) + let msg1 = msg0 <> badLength as n in pure $ mkNode opts (FailT msg1) [msg1] [] else eval (Proxy @(ParaImpl (LenT ps) ps)) opts as @@ -7875,7 +7958,7 @@ Left e -> e -- show1 opts " " [b] fails but using 'b' is ok and (b : []) also works! -- GE.List problem - Right b -> mkNode opts (PresentT [b]) [msgbase1 <> show0 opts " " (b : []) <> show1 opts " | " a] [hh pp] + Right b -> mkNode opts (PresentT [b]) [msgbase1 <> show0 opts " " [b] <> show1 opts " | " a] [hh pp] _ -> errorInProgram $ "ParaImpl base case should have exactly one element but found " ++ show as' instance (KnownNat n @@ -7905,7 +7988,7 @@ pure $ case getValueLRHide opts (msgbase1 <> " rhs failed " <> show b) qq [hh pp] of Left e -> e Right bs -> mkNode opts (PresentT (b:bs)) [msgbase1 <> show0 opts " " (b:bs) <> show1 opts " | " as'] [hh pp, hh qq] - _ -> errorInProgram $ "ParaImpl n+1 case has no data left" + _ -> errorInProgram "ParaImpl n+1 case has no data left" -- | leverages 'Para' for repeating predicates (passthrough method) -- @@ -7914,8 +7997,8 @@ -- PresentT [2,3,4,5] -- -- >>> pz @(ParaN 4 (Succ Id)) "azwxm" --- Error Para: invalid length:expected 4 but found 5 --- FailT "Para: invalid length:expected 4 but found 5" +-- Error Para:invalid length(5) expected 4 +-- FailT "Para:invalid length(5) expected 4" -- -- >>> pz @(ParaN 4 (Succ Id)) "azwx" -- Present "b{xy" @@ -7927,8 +8010,7 @@ , GetLen (RepeatT n p) ) => P (ParaN n p) [a] where type PP (ParaN n p) [a] = PP (Para (RepeatT n p)) [a] - eval _ opts as = - eval (Proxy @(Para (RepeatT n p))) opts as + eval _ = eval (Proxy @(Para (RepeatT n p))) -- | tries each predicate ps and on the first match runs the corresponding qs but if there is no match on ps then runs the fail case e -- @@ -8011,7 +8093,7 @@ ) => P (CaseImpl n e '[p] '[q] r) x where type PP (CaseImpl n e '[p] '[q] r) x = PP q (PP r x) eval _ opts z = do - let msgbase0 = "Case" <> "(" <> show n <> ")" + let msgbase0 = "Case(" <> show n <> ")" n :: Int = nat @n rr <- eval (Proxy @r) opts z case getValueLR opts msgbase0 rr [] of @@ -8024,7 +8106,7 @@ qq <- eval (Proxy @q) opts a pure $ case getValueLR opts msgbase0 qq [hh rr, hh pp] of Left e -> e - Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : if isVerbose opts then [hh qq] else []) + Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : [hh qq | isVerbose opts]) Right False -> do ee <- eval (Proxy @e) opts (a, Proxy @(PP q (PP r x))) pure $ case getValueLR opts (msgbase0 <> " otherwise failed") ee [hh rr, hh pp] of @@ -8062,7 +8144,7 @@ qq <- eval (Proxy @q) opts a pure $ case getValueLR opts msgbase0 qq [hh pp, hh rr] of Left e -> e - Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : if isVerbose opts then [hh qq] else []) + Right b -> mkNode opts (PresentT b) [show01 opts msgbase0 b a] (hh rr : hh pp : [hh qq | isVerbose opts]) Right False -> do ww <- eval (Proxy @(CaseImpl n e (p1 ': ps) (q1 ': qs) r)) opts z pure $ case getValueLR opts (msgbase1 <> " failed rhs") ww [hh rr, hh pp] of @@ -8080,14 +8162,7 @@ -- PresentT Nothing -- data Sequence -type TraverseT p q = Map p q >> Sequence -data Traverse p q - -instance P (TraverseT p q) x => P (Traverse p q) x where - type PP (Traverse p q) x = PP (TraverseT p q) x - eval _ = eval (Proxy @(TraverseT p q)) - instance (Show (f (t a)) , Show (t (f a)) , Traversable t @@ -8098,6 +8173,13 @@ let d = sequenceA tfa in pure $ mkNode opts (PresentT d) ["Sequence" <> show0 opts " " d <> show1 opts " | " tfa] [] +data Traverse p q +type TraverseT p q = Map p q >> Sequence + +instance P (TraverseT p q) x => P (Traverse p q) x where + type PP (Traverse p q) x = PP (TraverseT p q) x + eval _ = eval (Proxy @(TraverseT p q)) + -- | run the expression \'p\' but remove the subtrees data Hide p -- type H p = Hide p -- doesnt work with % -- unsaturated! @@ -8121,11 +8203,11 @@ data ReadFile p data FileExists p -type FileExistsT p = ReadFile p >> IsJust +type FileExistsT p = IsJust (ReadFile p) instance P (FileExistsT p) x => P (FileExists p) x where type PP (FileExists p) x = PP (FileExistsT p) x - eval _ = eval (Proxy @(FileExistsT p)) + eval _ = evalBool (Proxy @(FileExistsT p)) instance (PP p x ~ String, P p x) => P (ReadFile p) x where type PP (ReadFile p) x = Maybe String @@ -8153,11 +8235,11 @@ -- data ReadDir p data DirExists p -type DirExistsT p = ReadDir p >> IsJust +type DirExistsT p = IsJust (ReadDir p) instance P (DirExistsT p) x => P (DirExists p) x where type PP (DirExists p) x = PP (DirExistsT p) x - eval _ = eval (Proxy @(DirExistsT p)) + eval _ = evalBool (Proxy @(DirExistsT p)) instance (PP p x ~ String, P p x) => P (ReadDir p) x where @@ -8178,7 +8260,7 @@ Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] [] Just (Just b) -> mkNode opts (PresentT (Just b)) [msg1 <> " len=" <> show (length b) <> show0 opts " Just " b] [] --- | does the directory exists +-- | read an environment variable -- -- >>> pz @(ReadEnv "PATH" >> 'Just Id >> 'True) () -- True @@ -8201,35 +8283,38 @@ Just Nothing -> mkNode opts (PresentT Nothing) [msg1 <> " does not exist"] [] Just (Just v) -> mkNode opts (PresentT (Just v)) [msg1 <> showLit0 opts " " v] [] +-- | read all the environment variables as key value pairs data ReadEnvAll instance P ReadEnvAll a where type PP ReadEnvAll a = [(String,String)] eval _ opts _ = do let msg0 = "ReadEnvAll" - mb <- runIO $ getEnvironment + mb <- runIO getEnvironment pure $ case mb of Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [] Just v -> mkNode opts (PresentT v) [msg0 <> " count=" <> show (length v)] [] +-- | get the current time using 'UTCTime' data TimeUtc instance P TimeUtc a where type PP TimeUtc a = UTCTime eval _ opts _a = do let msg0 = "TimeUtc" - mb <- runIO $ getCurrentTime + mb <- runIO getCurrentTime pure $ case mb of Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [] Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] [] +-- | get the current time using 'ZonedTime' data TimeZt instance P TimeZt a where type PP TimeZt a = ZonedTime eval _ opts _a = do let msg0 = "TimeZt" - mb <- runIO $ getZonedTime + mb <- runIO getZonedTime pure $ case mb of Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [] Just v -> mkNode opts (PresentT v) [msg0 <> show0 opts " " v] [] @@ -8250,6 +8335,7 @@ data WriteFileImpl (hh :: FHandle Symbol) p +-- | append to a file data AppendFile (s :: Symbol) p type AppendFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p @@ -8258,6 +8344,7 @@ eval _ = eval (Proxy @(AppendFileT s p)) +-- | write to file, overwriting if needed data WriteFile' (s :: Symbol) p type WriteFileT' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p @@ -8265,6 +8352,7 @@ type PP (WriteFile' s p) x = PP (WriteFileT' s p) x eval _ = eval (Proxy @(WriteFileT' s p)) +-- | write to file, without overwriting data WriteFile (s :: Symbol) p type WriteFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p @@ -8272,7 +8360,7 @@ type PP (WriteFile s p) x = PP (WriteFileT s p) x eval _ = eval (Proxy @(WriteFileT s p)) - +-- | write a string value to stdout data Stdout p type StdoutT p = WriteFileImpl 'FStdout p @@ -8280,6 +8368,7 @@ type PP (Stdout p) x = PP (StdoutT p) x eval _ = eval (Proxy @(StdoutT p)) +-- | write a string value to stderr data Stderr p type StderrT p = WriteFileImpl 'FStderr p @@ -8305,31 +8394,36 @@ case getValueLR opts msg0 pp [] of Left e -> pure e Right ss -> do - mb <- runIO $ do - case fh of - FStdout -> fmap (left show) $ E.try @E.SomeException $ hPutStr stdout ss - FStderr -> fmap (left show) $ E.try @E.SomeException $ hPutStr stderr ss - FOther s w -> do - b <- doesFileExist s - if b && w == WFWrite then pure $ Left $ "file [" <> s <> "] already exists" - else do - let md = case w of - WFAppend -> AppendMode - _ -> WriteMode - fmap (left show) $ E.try @E.SomeException $ withFile s md (flip hPutStr ss) + mb <- runIO $ case fh of + FStdout -> fmap (left show) $ E.try @E.SomeException $ hPutStr stdout ss + FStderr -> fmap (left show) $ E.try @E.SomeException $ hPutStr stderr ss + FOther s w -> do + b <- doesFileExist s + if b && w == WFWrite then pure $ Left $ "file [" <> s <> "] already exists" + else do + let md = case w of + WFAppend -> AppendMode + _ -> WriteMode + fmap (left show) $ E.try @E.SomeException $ withFile s md (`hPutStr` ss) pure $ case mb of Nothing -> mkNode opts (FailT (msg0 <> " must run in IO")) [msg0 <> " must run in IO"] [hh pp] Just (Left e) -> mkNode opts (FailT e) [msg0 <> " " <> e] [hh pp] Just (Right ()) -> mkNode opts (PresentT ()) [msg0] [hh pp] +-- | read in a value of a given type from stdin with a prompt: similar to 'System.IO.readIO' +type ReadIO (t :: Type) = ReadIO' t "Enter value" +type ReadIO' (t :: Type) s = Stdout (s <> ":") >> Stdin >> ReadP t Id +-- eg pe2 @(ReadIO Int + ReadIO Int) () + +-- | read a value from stdin data Stdin -instance P Stdin a where - type PP Stdin a = String - eval _ opts _a = do +instance P Stdin x where + type PP Stdin x = String + eval _ opts _x = do let msg0 = "Stdin" mb <- runIO $ do - lr <- E.try $ hGetContents stdin + lr <- E.try getLine pure $ case lr of Left (e :: E.SomeException) -> Left $ show e Right ss -> Right ss @@ -8363,74 +8457,73 @@ -- data IsFixImpl (cmp :: Ordering) (ignore :: Bool) p q +instance (GetBool ignore + , P p x + , P q x + , PP p x ~ String + , PP q x ~ String + , GetOrdering cmp + ) => P (IsFixImpl cmp ignore p q) x where + type PP (IsFixImpl cmp ignore p q) x = Bool + eval _ opts x = do + let cmp = getOrdering @cmp + ignore = getBool @ignore + lwr = if ignore then map toLower else id + (ff,msg0) = case cmp of + LT -> (isPrefixOf, "IsPrefix") + EQ -> (isInfixOf, "IsInfix") + GT -> (isSuffixOf, "IsSuffix") + pp <- eval (Proxy @p) opts x + case getValueLR opts msg0 pp [] of + Left e -> pure e + Right s0 -> do + let msg1 = msg0 <> (if ignore then "I" else "") <> "(" <> s0 <> ")" + qq <- eval (Proxy @q) opts x + pure $ case getValueLR opts (msg1 <> " q failed") qq [hh pp] of + Left e -> e + Right s1 -> mkNodeB opts (on ff lwr s0 s1) [msg1 <> showLit0 opts " " s1] [hh pp, hh qq] data IsPrefix p q type IsPrefixT p q = IsFixImpl 'LT 'False p q instance P (IsPrefixT p q) x => P (IsPrefix p q) x where type PP (IsPrefix p q) x = PP (IsPrefixT p q) x - eval _ = eval (Proxy @(IsPrefixT p q)) + eval _ = evalBool (Proxy @(IsPrefixT p q)) data IsInfix p q type IsInfixT p q = IsFixImpl 'EQ 'False p q instance P (IsInfixT p q) x => P (IsInfix p q) x where type PP (IsInfix p q) x = PP (IsInfixT p q) x - eval _ = eval (Proxy @(IsInfixT p q)) + eval _ = evalBool (Proxy @(IsInfixT p q)) data IsSuffix p q type IsSuffixT p q = IsFixImpl 'GT 'False p q instance P (IsSuffixT p q) x => P (IsSuffix p q) x where type PP (IsSuffix p q) x = PP (IsSuffixT p q) x - eval _ = eval (Proxy @(IsSuffixT p q)) + eval _ = evalBool (Proxy @(IsSuffixT p q)) data IsPrefixI p q type IsPrefixIT p q = IsFixImpl 'LT 'True p q instance P (IsPrefixIT p q) x => P (IsPrefixI p q) x where type PP (IsPrefixI p q) x = PP (IsPrefixIT p q) x - eval _ = eval (Proxy @(IsPrefixIT p q)) + eval _ = evalBool (Proxy @(IsPrefixIT p q)) data IsInfixI p q type IsInfixIT p q = IsFixImpl 'EQ 'True p q instance P (IsInfixIT p q) x => P (IsInfixI p q) x where type PP (IsInfixI p q) x = PP (IsInfixIT p q) x - eval _ = eval (Proxy @(IsInfixIT p q)) + eval _ = evalBool (Proxy @(IsInfixIT p q)) data IsSuffixI p q type IsSuffixIT p q = IsFixImpl 'GT 'True p q instance P (IsSuffixIT p q) x => P (IsSuffixI p q) x where type PP (IsSuffixI p q) x = PP (IsSuffixIT p q) x - eval _ = eval (Proxy @(IsSuffixIT p q)) - -instance (GetBool ignore - , P p x - , P q x - , PP p x ~ String - , PP q x ~ String - , GetOrdering cmp - ) => P (IsFixImpl cmp ignore p q) x where - type PP (IsFixImpl cmp ignore p q) x = Bool - eval _ opts x = do - let cmp = getOrdering @cmp - ignore = getBool @ignore - lwr = if ignore then map toLower else id - (ff,msg0) = case cmp of - LT -> (isPrefixOf, "IsPrefix") - EQ -> (isInfixOf, "IsInfix") - GT -> (isSuffixOf, "IsSuffix") - pp <- eval (Proxy @p) opts x - case getValueLR opts msg0 pp [] of - Left e -> pure e - Right s0 -> do - let msg1 = msg0 <> (if ignore then "I" else "") <> "(" <> s0 <> ")" - qq <- eval (Proxy @q) opts x - pure $ case getValueLR opts (msg1 <> " q failed") qq [hh pp] of - Left e -> e - Right s1 -> mkNodeB opts (on ff lwr s0 s1) [msg1 <> showLit0 opts " " s1] [hh pp, hh qq] + eval _ = evalBool (Proxy @(IsSuffixIT p q)) -- | similar to 'SG.<>' -- @@ -8809,7 +8902,7 @@ Left e -> e Right (p,q,pp,qq) -> let d = p q - in mkNode opts (PresentT d) ["fn $$ " <> show q <> " = " <> show d] [hh pp, hh qq] + in mkNode opts (PresentT d) [msg0 <> " " <> show q <> " = " <> show d] [hh pp, hh qq] -- reify this so we can combine (type synonyms dont work as well) @@ -8842,7 +8935,7 @@ Left e -> e Right (p,q,pp,qq) -> let d = p q - in mkNode opts (PresentT d) ["fn $& " <> show q <> " = " <> show d] [hh pp, hh qq] + in mkNode opts (PresentT d) [msg0 <> " " <> show q <> " = " <> show d] [hh pp, hh qq] type family FnT ab :: Type where FnT (a -> b) = b @@ -9010,8 +9103,7 @@ data Repeat (n :: Nat) p instance P (RepeatT n p) a => P (Repeat n p) a where type PP (Repeat n p) a = PP (RepeatT n p) a - eval _ opts a = - eval (Proxy @(RepeatT n p)) opts a + eval _ = eval (Proxy @(RepeatT n p)) -- | leverages 'Do' for repeating predicates (passthrough method) -- same as @DoN n p == FoldN n p Id@ but more efficient @@ -9032,8 +9124,7 @@ type DoNT (n :: Nat) p = Do (RepeatT n p) instance P (DoNT n p) a => P (DoN n p) a where type PP (DoN n p) a = PP (DoNT n p) a - eval _ opts a = - eval (Proxy @(DoNT n p)) opts a + eval _ = eval (Proxy @(DoNT n p)) -- | extract the value from a 'Maybe' otherwise use the default value -- @@ -9070,7 +9161,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Just b -> pure $ mkNode opts (PresentT b) [msg0 <> " Just"] [hh qq] Nothing -> do @@ -9118,7 +9209,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Just b -> pure $ mkNode opts (PresentT b) [msg0 <> " Just"] [hh qq] Nothing -> do @@ -9164,7 +9255,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Left a -> pure $ mkNode opts (PresentT a) [msg0 <> " Left"] [hh qq] Right b -> do @@ -9224,7 +9315,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Right b -> pure $ mkNode opts (PresentT b) [msg0 <> " Right"] [hh qq] Left a -> do @@ -9267,7 +9358,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Left a -> pure $ mkNode opts (PresentT a) [msg0 <> " Left"] [hh qq] Right b -> do @@ -9310,7 +9401,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of Right b -> pure $ mkNode opts (PresentT b) [msg0 <> " Right"] [hh qq] Left a -> do @@ -9362,7 +9453,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of This a -> pure $ mkNode opts (PresentT a) [msg0 <> " This"] [hh qq] _ -> do @@ -9434,7 +9525,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of That a -> pure $ mkNode opts (PresentT a) [msg0 <> " That"] [hh qq] _ -> do @@ -9484,7 +9575,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of These a b -> pure $ mkNode opts (PresentT (a,b)) [msg0 <> " These"] [hh qq] _ -> do @@ -9527,7 +9618,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of This a -> pure $ mkNode opts (PresentT a) [msg0 <> " This"] [hh qq] _ -> do @@ -9570,7 +9661,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of That a -> pure $ mkNode opts (PresentT a) [msg0 <> " That"] [hh qq] _ -> do @@ -9615,7 +9706,7 @@ qq <- eval (Proxy @q) opts x case getValueLR opts msg0 qq [] of Left e -> pure e - Right q -> do + Right q -> case q of These a b -> pure $ mkNode opts (PresentT (a,b)) [msg0 <> " These"] [hh qq] _ -> do @@ -9820,14 +9911,12 @@ -- False (4 <= 3) -- FalseT -- -data (p :: Type -> Type) $ (q :: Type) +data (p :: k -> k1) $ (q :: k) infixr 0 $ instance P (p q) a => P (p $ q) a where type PP (p $ q) a = PP (p q) a - eval _ opts a = do - eval (Proxy @(p q)) opts a - + eval _ = eval (Proxy @(p q)) -- | similar to 'Control.Lens.&' -- @@ -9835,15 +9924,30 @@ -- Present 1 (Length 1 | [13]) -- PresentT 1 -- -data (q :: Type) & (p :: Type -> Type) +-- >>> 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' +-- +data (q :: k) & (p :: k -> k1) infixl 1 & instance P (p q) a => P (q & p) a where type PP (q & p) a = PP (p q) a - eval _ opts a = do - eval (Proxy @(p q)) opts a + eval _ = eval (Proxy @(p q)) --- | creates a constant expression ignoring the second arguenent +-- | 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) @@ -9853,7 +9957,15 @@ -- Present ("abc",((1,(2,9,10)),(3,4))) (K'(,)) -- PresentT ("abc",((1,(2,9,10)),(3,4))) -- -data K (p :: k) (q :: Type) +-- >>> 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 '`' +-- +data K (p :: k) (q :: k1) instance P p a => P (K p q) a where type PP (K p q) a = PP p a eval _ = eval (Proxy @(Msg "K" p)) @@ -9875,6 +9987,12 @@ -- >>> 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) +-- +-- todo: add topMessage somehow? data Both p q instance ( ExtractL1C (PP q x) , ExtractL2C (PP q x) @@ -10035,4 +10153,157 @@ type PP (ParseJsonFile t p) x = PP (ParseJsonFileT t p) x eval _ = eval (Proxy @(ParseJsonFileT t p)) +-- | 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 +-- +data Uncurry (p :: Type -> Type -> Type -> Type) q r + +instance (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) x where + type PP (Uncurry p q r) x = PP (p (ExtractL1T (PP q x)) (ExtractL2T (PP q x)) (PP r x)) x + eval _ opts x = do + let msg0 = "Uncurry" + lr <- runPQ msg0 (Proxy @q) (Proxy @r) opts x [] + case lr of + Left e -> pure e + Right ((q1,q2),r,qq,rr) -> do + let hhs0 = [hh qq, hh rr] + pp <- eval (Proxy @(p (Fst Id) (Snd Id) (Thd Id))) opts (q1,q2,r) + pure $ case getValueLR opts msg0 pp hhs0 of + Left e -> e + Right _ -> + let hhs = hhs0 ++ [hh pp] + in mkNode opts (_tBool pp) [msg0 <> " " <> topMessage pp] hhs + +-- | like 'Predicate.Prelude.&&' but for a tuple +-- +-- >>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) () +-- False ((>>) False | {False (&*) True | (4 > 4)}) +-- FalseT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "Cabc" +-- True ((>>) True | {True (&*) True}) +-- TrueT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "CabD" +-- False ((>>) False | {True (&*) False | (IsLower | "abD")}) +-- FalseT +-- +-- >>> pl @(Just Uncons >> ('[Id] >> IsUpper) &* IsLower) "2abd" +-- False ((>>) False | {IsUpper | "2"})}) +-- FalseT +-- +data AndA p q r +instance (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) x where + type PP (AndA p q r) x = Bool + eval _ opts x = do + let msg0 = "(&*)" + rr <- eval (Proxy @r) opts x + case getValueLR opts msg0 rr [] of + Left e -> pure e + Right (r1,r2) -> do + pp <- evalBool (Proxy @p) opts r1 + case getValueLR opts msg0 pp [hh rr] of + Left e -> pure e + Right p -> do + qq <- evalBool (Proxy @q) opts r2 + pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of + Left e -> e + Right q -> + let zz = case (p,q) of + (True, True) -> "" + (False, True) -> topMessage pp + (True, False) -> topMessage qq + (False, False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq + in mkNodeB opts (p&&q) [show p <> " " <> msg0 <> " " <> show q <> (if null zz then zz else " | " <> zz)] [hh rr, hh pp, hh qq] + +data p &* q +type AndAT p q = AndA p q Id +infixr 3 &* + +instance P (AndAT p q) x => P (p &* q) x where + type PP (p &* q) x = PP (AndAT p q) x + eval _ = evalBool (Proxy @(AndAT p q)) + +{- +data p &&! q +type AndAT' p q = (Fst Id >> p) && (Snd Id >> q) +infixr 3 &&! + +instance (P (AndAT' p q) x + ) => P (p &&! q) x where + type PP (p &&! q) x = PP (AndAT' p q) x + eval _ = evalBool (Proxy @(AndAT' p q)) +-} + +-- | like 'Predicate.Prelude.||' 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 +-- +data OrA p q r +instance (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) x where + type PP (OrA p q r) x = Bool + eval _ opts x = do + let msg0 = "(|+)" + rr <- eval (Proxy @r) opts x + case getValueLR opts msg0 rr [] of + Left e -> pure e + Right (r1,r2) -> do + pp <- evalBool (Proxy @p) opts r1 + case getValueLR opts msg0 pp [hh rr] of + Left e -> pure e + Right p -> do + qq <- evalBool (Proxy @q) opts r2 + pure $ case getValueLR opts msg0 qq [hh rr, hh pp] of + Left e -> e + Right q -> + let zz = case (p,q) of + (False,False) -> topMessage pp <> " " <> msg0 <> " " <> topMessage qq + _ -> "" + in mkNodeB opts (p||q) [show p <> " " <> msg0 <> " " <> show q <> (if null zz then zz else " | " <> zz)] [hh rr, hh pp, hh qq] + +data p |+ q +type OrAT p q = OrA p q Id +infixr 3 |+ + +instance P (OrAT p q) x => P (p |+ q) x where + type PP (p |+ q) x = PP (OrAT p q) x + eval _ = evalBool (Proxy @(OrAT p q))
src/Predicate/Refined.hs view
@@ -86,10 +86,10 @@ -- | a simple refinement type that ensures the predicate \'p\' holds for the type \'a\' -- --- >>> prtRefinedIO @(Between 10 14) oz 13 +-- >>> prtRefinedIO @(Between 10 14 Id) oz 13 -- Right (Refined {unRefined = 13}) -- --- >>> prtRefinedIO @(Between 10 14) oz 99 +-- >>> prtRefinedIO @(Between 10 14 Id) oz 99 -- Left FalseP -- -- >>> prtRefinedIO @(Last Id >> Len == 4) oz ["one","two","three","four"] @@ -104,10 +104,10 @@ -- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> 'True) oz "141.213.1" -- Left (FailP "bad length: found 3") -- --- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255) >> 'True) oz "141.213.1.444" +-- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255 Id) >> 'True) oz "141.213.1.444" -- Left (FailP "octet 3 out of range 444") -- --- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255) >> 'True) oz "141.213.1x34.444" +-- >>> prtRefinedIO @(Map (ReadP Int Id) (Resplit "\\." Id) >> Guard (PrintF "bad length: found %d" Len) (Len == 4) >> GuardsN (PrintT "octet %d out of range %d" Id) 4 (Between 0 255 Id) >> 'True) oz "141.213.1x34.444" -- Left (FailP "ReadP Int (1x34)") -- -- >>> prtRefinedIO @(Map ('[Id] >> ReadP Int Id) Id >> Luhn Id) oz "12344" @@ -141,10 +141,10 @@ -- | 'Read' instance for 'Refined' -- --- >>> reads @(Refined (Between 0 255) Int) "Refined {unRefined = 254}" +-- >>> reads @(Refined (Between 0 255 Id) Int) "Refined {unRefined = 254}" -- [(Refined {unRefined = 254},"")] -- --- >>> reads @(Refined (Between 0 255) Int) "Refined {unRefined = 300}" +-- >>> reads @(Refined (Between 0 255 Id) Int) "Refined {unRefined = 300}" -- [] -- @@ -178,10 +178,10 @@ -- -- >>> :set -XOverloadedStrings -- >>> import qualified Data.Aeson as A --- >>> A.eitherDecode' @(Refined (Between 10 14) Int) "13" +-- >>> A.eitherDecode' @(Refined (Between 10 14 Id) Int) "13" -- Right (Refined {unRefined = 13}) -- --- >>> removeAnsi $ A.eitherDecode' @(Refined (Between 10 14) Int) "16" +-- >>> removeAnsi $ A.eitherDecode' @(Refined (Between 10 14 Id) Int) "16" -- Error in $: Refined:FalseP -- False 16 <= 14 -- | @@ -206,34 +206,26 @@ -- >>> import Control.Lens -- >>> import Control.Arrow ((+++)) -- >>> type K1 = Refined (ReadP Day Id >> 'True) String --- >>> type K2 = Refined (ReadP Day Id >> Between (ReadP Day "2019-03-30") (ReadP Day "2019-06-01")) String --- >>> type K3 = Refined (ReadP Day Id >> Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01")) String +-- >>> type K2 = Refined (Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01") (ReadP Day Id)) String -- >>> r = unsafeRefined' oz "2019-04-23" :: K1 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K1 (B.encode r) -- Refined {unRefined = "2019-04-23"} -- -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K2 (B.encode r) --- Refined {unRefined = "2019-04-23"} --- --- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K3 (B.encode r) -- Refined:FalseP --- False (>>) False | {2019-05-30 <= 2019-04-23} +-- False 2019-05-30 <= 2019-04-23 -- | -- +- P ReadP Day 2019-04-23 -- | | -- | `- P Id "2019-04-23" -- | --- `- False 2019-05-30 <= 2019-04-23 --- | --- +- P Id 2019-04-23 --- | --- +- P ReadP Day 2019-05-30 --- | | --- | `- P '2019-05-30 +-- +- P ReadP Day 2019-05-30 +-- | | +-- | `- P '2019-05-30 +-- | +-- `- P ReadP Day 2019-06-01 -- | --- `- P ReadP Day 2019-06-01 --- | --- `- P '2019-06-01 +-- `- P '2019-06-01 -- <BLANKLINE> -- instance (RefinedC p a, Binary a) => Binary (Refined p a) where
src/Predicate/Refined2.hs view
@@ -171,10 +171,10 @@ -- read instance from -ddump-deriv -- | 'Read' instance for 'Refined2' -- --- >>> reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255) String) "Refined2 {r2In = 254, r2Out = \"fe\"}" +-- >>> reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255 Id) String) "Refined2 {r2In = 254, r2Out = \"fe\"}" -- [(Refined2 {r2In = 254, r2Out = "fe"},"")] -- --- >>> reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255) String) "Refined2 {r2In = 300, r2Out = \"12c\"}" +-- >>> reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255 Id) String) "Refined2 {r2In = 300, r2Out = \"12c\"}" -- [] -- -- >>> reads @(Refined2 (ReadBase Int 16 Id) (Id < 0) String) "Refined2 {r2In = -1234, r2Out = \"-4d2\"}" @@ -215,7 +215,7 @@ -- | 'ToJSON' instance for 'Refined2' -- -- >>> import qualified Data.Aeson as A --- >>> A.encode (unsafeRefined2 @(ReadBase Int 16 Id) @(Between 0 255) 254 "fe") +-- >>> A.encode (unsafeRefined2 @(ReadBase Int 16 Id) @(Between 0 255 Id) 254 "fe") -- "\"fe\"" -- -- >>> A.encode (unsafeRefined2 @Id @'True @Int 123 123) @@ -244,7 +244,7 @@ -- <BLANKLINE> -- False True && False | (16663610 < 256) -- | --- +- True 16663610 > 10 +-- +- True 16663610 > 10 -- | | -- | +- P Id 16663610 -- | | @@ -276,16 +276,12 @@ -- >>> import Control.Lens -- >>> import Data.Time -- >>> type K1 = Refined2 (ReadP Day Id) 'True String --- >>> type K2 = Refined2 (ReadP Day Id) (Between (ReadP Day "2019-03-30") (ReadP Day "2019-06-01")) String --- >>> type K3 = Refined2 (ReadP Day Id) (Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01")) String +-- >>> type K2 = Refined2 (ReadP Day Id) (Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01") Id) String -- >>> r = unsafeRefined2' oz "2019-04-23" :: K1 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K1 (B.encode r) -- Refined2 {r2In = 2019-04-23, r2Out = "2019-04-23"} -- -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K2 (B.encode r) --- Refined2 {r2In = 2019-04-23, r2Out = "2019-04-23"} --- --- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K3 (B.encode r) -- Refined2:Step 2. False Boolean Check(op) | {2019-05-30 <= 2019-04-23} -- <BLANKLINE> -- *** Step 1. Success Initial Conversion(ip) [2019-04-23] *** @@ -336,12 +332,12 @@ -- reads a binary string and adds the values together -- -- >>> :set -XPolyKinds --- >>> prtRefinedTIO $ withRefined2T @(ReadBase Int 16 Id) @(Between 100 200) oz "a3" $ \x -> withRefined2T @(ReadBase Int 2 Id) @'True oz "1001110111" $ \y -> pure (r2In x + r2In y) +-- >>> prtRefinedTIO $ withRefined2T @(ReadBase Int 16 Id) @(Between 100 200 Id) oz "a3" $ \x -> withRefined2T @(ReadBase Int 2 Id) @'True oz "1001110111" $ \y -> pure (r2In x + r2In y) -- 794 -- -- this example fails as the the hex value is out of range -- --- >>> prtRefinedTIO $ withRefined2T @(ReadBase Int 16 Id) @(Between 100 200) o0 "a388" $ \x -> withRefined2T @(ReadBase Int 2 Id) @'True o0 "1001110111" $ \y -> pure (x,y) +-- >>> prtRefinedTIO $ withRefined2T @(ReadBase Int 16 Id) @(Between 100 200 Id) o0 "a388" $ \x -> withRefined2T @(ReadBase Int 2 Id) @'True o0 "1001110111" $ \y -> pure (x,y) -- <BLANKLINE> -- *** Step 1. Success Initial Conversion(ip) [41864] *** -- <BLANKLINE>
src/Predicate/Refined3.hs view
@@ -215,10 +215,10 @@ -- read instance from -ddump-deriv -- | 'Read' instance for 'Refined3' -- --- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 254, r3Out = \"fe\"}" +-- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255 Id) (ShowBase 16 Id) String) "Refined3 {r3In = 254, r3Out = \"fe\"}" -- [(Refined3 {r3In = 254, r3Out = "fe"},"")] -- --- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 300, r3Out = \"12c\"}" +-- >>> reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255 Id) (ShowBase 16 Id) String) "Refined3 {r3In = 300, r3Out = \"12c\"}" -- [] -- -- >>> reads @(Refined3 (ReadBase Int 16 Id) (Id < 0) (ShowBase 16 Id) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}" @@ -260,7 +260,7 @@ -- | 'ToJSON' instance for 'Refined3' -- -- >>> import qualified Data.Aeson as A --- >>> A.encode (unsafeRefined3 @(ReadBase Int 16 Id) @(Between 0 255) @(ShowBase 16 Id) 254 "fe") +-- >>> A.encode (unsafeRefined3 @(ReadBase Int 16 Id) @(Between 0 255 Id) @(ShowBase 16 Id) 254 "fe") -- "\"fe\"" -- -- >>> A.encode (unsafeRefined3 @Id @'True @Id 123 123) @@ -289,7 +289,7 @@ -- <BLANKLINE> -- False True && False | (16663610 < 256) -- | --- +- True 16663610 > 10 +-- +- True 16663610 > 10 -- | | -- | +- P Id 16663610 -- | | @@ -346,16 +346,12 @@ -- >>> import Control.Lens -- >>> import Data.Time -- >>> type K1 = MakeR3 '(ReadP Day Id, 'True, ShowP Id, String) --- >>> type K2 = MakeR3 '(ReadP Day Id, Between (ReadP Day "2019-03-30") (ReadP Day "2019-06-01"), ShowP Id, String) --- >>> type K3 = MakeR3 '(ReadP Day Id, Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01"), ShowP Id, String) +-- >>> type K2 = MakeR3 '(ReadP Day Id, Between (ReadP Day "2019-05-30") (ReadP Day "2019-06-01") Id, ShowP Id, String) -- >>> r = unsafeRefined3' oz "2019-04-23" :: K1 -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K1 (B.encode r) -- Refined3 {r3In = 2019-04-23, r3Out = "2019-04-23"} -- -- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K2 (B.encode r) --- Refined3 {r3In = 2019-04-23, r3Out = "2019-04-23"} --- --- >>> removeAnsi $ (view _3 +++ view _3) $ B.decodeOrFail @K3 (B.encode r) -- Refined3:Step 2. False Boolean Check(op) | {2019-05-30 <= 2019-04-23} -- <BLANKLINE> -- *** Step 1. Success Initial Conversion(ip) [2019-04-23] *** @@ -433,7 +429,7 @@ -- reads a binary string and adds the values together -- -- >>> :set -XPolyKinds --- >>> b16 = Proxy @'(ReadBase Int 16 Id, Between 100 200, ShowBase 16 Id, String) +-- >>> b16 = Proxy @'(ReadBase Int 16 Id, Between 100 200 Id, ShowBase 16 Id, String) -- >>> b2 = Proxy @'(ReadBase Int 2 Id, 'True, ShowBase 2 Id, String) -- >>> prtRefinedTIO $ withRefined3TP b16 oz "a3" $ \x -> withRefined3TP b2 oz "1001110111" $ \y -> pure (r3In x + r3In y) -- 794
src/Predicate/Util.hs view
@@ -140,6 +140,7 @@ , ConsT , type (%%) , type (%&) + , type (<%>) -- ** extract values from the type level , nat @@ -331,7 +332,7 @@ in left (\e -> mkNode opts (FailT e) - [msg0 <> if showError then (if null msg0 then "" else " ") <> "[" <> e <> "]" + [msg0 <> if showError || isVerbose opts then (if null msg0 then "" else " ") <> "[" <> e <> "]" else ""] tt' ) @@ -368,22 +369,22 @@ } data ODebug = - OZero - | OLite - | OSubNormal - | ONormal - | OVerbose + OZero -- ^ one line summary used mainly for testing + | OLite -- ^ one line summary with additional context from the head of the evaluation tree + | OSubNormal -- ^ outputs the evaluation tree but skips noisy subtrees + | ONormal -- ^ outputs the evaluation tree but skips noisy subtrees + | OVerbose -- ^ outputs the entire evaluation tree deriving (Ord, Show, Eq, Enum, Bounded) --- | skip colors and just return the summary +-- | minimal data without colors oz :: POpts oz = defOpts { oColor = color0, oDebug = OZero } --- | skip colors and just return the summary +-- | returns the summary without colors ol :: POpts ol = defOpts { oColor = color0, oDebug = OLite } --- | skip the detail and just return the summary but keep the colors +-- | same as 'ol' but with colors olc :: POpts olc = ol { oColor = color1 } @@ -626,7 +627,7 @@ (excs@(e:_), _) -> Left $ mkNode opts (FailT (groupErrors (map snd excs))) - (msgs <> ["excs=" <> show (length excs) <> " " <> formatList opts [fst e]]) + (msgs <> [formatList opts [fst e] <> " excnt=" <> show (length excs)]) (map (hh . snd) ts) ([], tfs) -> Right tfs @@ -899,7 +900,7 @@ \case b@(FailP e) -> "[" <> colorMe o b "Error" <> nullSpace e <> "]" b@PresentP -> colorMe o b "P" - b@TrueP -> colorMe o b "True " + b@TrueP -> colorMe o b "True" b@FalseP -> colorMe o b "False" displayMessages :: [String] -> String @@ -999,10 +1000,13 @@ RepeatT 1 p = p ': '[] RepeatT n p = p ': RepeatT (n GN.- 1) p +type s <%> t = GL.AppendSymbol s t +infixr 6 <%> + type family IntersperseT (s :: Symbol) (xs :: [Symbol]) :: Symbol where IntersperseT s '[] = "" IntersperseT s '[x] = x - IntersperseT s (x ': y ': xs) = x `GL.AppendSymbol` s `GL.AppendSymbol` IntersperseT s (y ': xs) + IntersperseT s (x ': y ': xs) = x <%> s <%> IntersperseT s (y ': xs) type family LenT (xs :: [k]) :: Nat where LenT '[] = 0
src/Predicate/Util_TH.hs view
@@ -41,21 +41,21 @@ -- | creates a 'Refined.Refined' refinement type with terse output -- -- @ --- >$$(refinedTH 123) :: Refined (Between 100 125) Int +-- >$$(refinedTH 123) :: Refined (Between 100 125 Id) Int -- Refined {unRefined = 123} --- it :: Refined (Between 100 125) Int +-- it :: Refined (Between 100 125 Id) Int -- @ -- -- @ --- >$$(refinedTH 99) :: Refined (Between 100 125) Int +-- >$$(refinedTH 99) :: Refined (Between 100 125 Id) Int -- -- <interactive>:8:4: error: -- * refinedTH: predicate failed with FalseP (100 <= 99) -- * In the Template Haskell splice $$(refinedTH 99) -- In the expression: --- $$(refinedTH 99) :: Refined (Between 100 125) Int +-- $$(refinedTH 99) :: Refined (Between 100 125 Id) Int -- In an equation for \'it\': --- it = $$(refinedTH 99) :: Refined (Between 100 125) Int +-- it = $$(refinedTH 99) :: Refined (Between 100 125 Id) Int -- @ -- refinedTH :: forall p i @@ -69,13 +69,13 @@ -- allows you to specify display options (eg 'ou' for unicode / 'o2' for ansi) -- -- @ --- >$$(refinedTH' o2 123) :: Refined (Between 100 125) Int +-- >$$(refinedTH' o2 123) :: Refined (Between 100 125 Id) Int -- Refined {unRefined = 123} --- it :: Refined (Between 100 125) Int +-- it :: Refined (Between 100 125 Id) Int -- @ -- -- @ --- >$$(refinedTH' o2 99) :: Refined (FailS "asdf" >> Between 100 125) Int +-- >$$(refinedTH' o2 99) :: Refined (FailS "asdf" >> Between 100 125 Id) Int -- -- <interactive>:116:4: error: -- * @@ -89,7 +89,7 @@ -- * In the Template Haskell splice $$(refinedTH' o0 99) -- In the expression: -- $$(refinedTH' o2 99) :: --- Refined (FailS "asdf" >> Between 100 125) Int +-- Refined (FailS "asdf" >> Between 100 125 Id) Int -- @ -- refinedTH' :: forall p i @@ -109,7 +109,7 @@ -- | creates a 'Refined2.Refined2' refinement type with terse output -- -- @ --- >$$(refined2TH 100) :: Refined2 Id (Between 100 125) Id Int +-- >$$(refined2TH 100) :: Refined2 Id (Between 100 125 Id) Id Int -- Refined2 {r2In = 100, r2Out = 100} -- @ -- @@ -124,12 +124,12 @@ -- allows you to specify display options (eg 'ou' for unicode / 'o2' for ansi) -- -- @ --- >$$(refined2TH' o2 100) :: Refined2 Id (Between 100 125) Int +-- >$$(refined2TH' o2 100) :: Refined2 Id (Between 100 125 Id) Int -- Refined2 {r2In = 100, r2Out = 100} -- @ -- -- @ --- >$$(refined2TH' o2 99) :: Refined2 Id (Between 100 125) Int +-- >$$(refined2TH' o2 99) :: Refined2 Id (Between 100 125 Id) Int -- -- <interactive>:127:4: error: -- * @@ -150,9 +150,9 @@ -- refined2TH: predicate failed with Step 2. False Boolean Check(op) | {100 <= 99} -- * In the Template Haskell splice $$(refined2TH' o2 99) -- In the expression: --- $$(refined2TH' o2 99) :: Refined2 Id (Between 100 125) Id Int +-- $$(refined2TH' o2 99) :: Refined2 Id (Between 100 125 Id) Id Int -- In an equation for \'it\': --- it = $$(refined2TH' o2 99) :: Refined2 Id (Between 100 125) Id Int +-- it = $$(refined2TH' o2 99) :: Refined2 Id (Between 100 125 Id) Id Int -- @ -- refined2TH' :: forall ip op i @@ -173,7 +173,7 @@ -- | creates a 'Refined3.Refined3' refinement type with terse output -- -- @ --- >$$(refined3TH 100) :: Refined3 Id (Between 100 125) Id Int +-- >$$(refined3TH 100) :: Refined3 Id (Between 100 125 Id) Id Int -- Refined3 {r3In = 100, r3Out = 100} -- @ -- @@ -188,12 +188,12 @@ -- allows you to specify display options (eg 'ou' for unicode / 'o2' for ansi) -- -- @ --- >$$(refined3TH' o2 100) :: Refined3 Id (Between 100 125) Id Int +-- >$$(refined3TH' o2 100) :: Refined3 Id (Between 100 125 Id) Id Int -- Refined3 {r3In = 100, r3Out = 100} -- @ -- -- @ --- >$$(refined3TH' o2 99) :: Refined3 Id (Between 100 125) Id Int +-- >$$(refined3TH' o2 99) :: Refined3 Id (Between 100 125 Id) Id Int -- -- <interactive>:127:4: error: -- * @@ -214,9 +214,9 @@ -- refined3TH: predicate failed with Step 2. False Boolean Check(op) | {100 <= 99} -- * In the Template Haskell splice $$(refined3TH' o2 99) -- In the expression: --- $$(refined3TH' o2 99) :: Refined3 Id (Between 100 125) Id Int +-- $$(refined3TH' o2 99) :: Refined3 Id (Between 100 125 Id) Id Int -- In an equation for \'it\': --- it = $$(refined3TH' o2 99) :: Refined3 Id (Between 100 125) Id Int +-- it = $$(refined3TH' o2 99) :: Refined3 Id (Between 100 125 Id) Id Int -- @ -- refined3TH' :: forall ip op fmt i
test/TastyExtras.hs view
@@ -48,7 +48,7 @@ toFrom = eitherDecode . encode orderTests :: String -> [Assertion] -> [TestTree] -orderTests s = zipWith (\i t -> testCase (s <> show i) t) [1::Int ..] +orderTests s = zipWith (\i -> testCase (s <> "_" <> show i)) [1::Int ..] expectPE :: (Show a, Eq a, HasCallStack) => BoolT a -> IO (BoolT a) -> IO () expectPE bp m = do
test/TestJson.hs view
@@ -77,6 +77,6 @@ >> Guard (PrintF "not upper first(%c)" Id) ('[Id] >> IsUpper) *** Guard (PrintF "not lower rest(%s)" Id) IsLower -type AgeR = R.Refined (Between 10 60) Int +type AgeR = R.Refined (Between 10 60 Id) Int
test/TestPredicate.hs view
@@ -185,8 +185,8 @@ , expectPE (PresentT []) $ pl @(MEmptyT _ ||| Ones Id) (Left @_ @[String] ["ab"]) , expectPE (PresentT ["a","b"]) $ pl @(MaybeIn MEmptyP (Ones Id)) (Just @String "ab") , expectPE (PresentT []) $ pl @(MaybeIn MEmptyP (Ones Id)) (Nothing @String) - , expectPE (PresentT (True, 13)) $ pl @(Not IsNothing &&& (Just Id >> Id + 12)) (Just 1) - , expectPE (FailT "Just(empty)") $ pl @(Not IsNothing &&& (Just Id >> Id + 12)) Nothing + , expectPE (PresentT (True, 13)) $ pl @(Not (IsNothing Id) &&& (Just Id >> Id + 12)) (Just 1) + , expectPE (FailT "Just(empty)") $ pl @(Not (IsNothing Id) &&& (Just Id >> Id + 12)) Nothing , expectPE (PresentT True) $ pl @(Thd Id >> Fst Id) (1,2,(True,4)) , expectPE (PresentT True) $ pl @(Fst (Thd Id)) (1,2,(True,4)) , expectPE (PresentT 'd') $ pl @(Id !! 3) ("asfd" :: T.Text) @@ -303,9 +303,9 @@ , expectPE TrueT $ pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldMap (SG.Sum _) Id >> Gt 200)) [] , expectPE (PresentT (False, 210)) $ pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) &&& FoldMap (SG.Sum _) Id) [1..20] , expectPE (PresentT 'g') $ pl @(Id !! 6) ['a'..'z'] - , expectPE (PresentT ([141,214,125,1,2,3333],(False,False))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> '(Id, '(Len == 4, All (Between 0 255) Id))) "141.214.125.1.2.3333" - , expectPE (PresentT ([141,214,125,1,2,6],(False,True))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> Id &&& ((Len == 4) &&& All (Between 0 255) Id)) "141.214.125.1.2.6" - , expectPE (FailT "ReadP Int ()") $ pl @(Resplit "\\." Id >> Map (ReadP Int Id) Id >> Id &&& ((Len == 4) &&& All (Between 0 255) Id)) "141.214.125." + , expectPE (PresentT ([141,214,125,1,2,3333],(False,False))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> '(Id, '(Len == 4, All (Between 0 255 Id) Id))) "141.214.125.1.2.3333" + , expectPE (PresentT ([141,214,125,1,2,6],(False,True))) $ pl @(Map (ReadP Int Id) (Resplit "\\." Id) >> Id &&& ((Len == 4) &&& All (Between 0 255 Id) Id)) "141.214.125.1.2.6" + , expectPE (FailT "ReadP Int ()") $ pl @(Resplit "\\." Id >> Map (ReadP Int Id) Id >> Id &&& ((Len == 4) &&& All (Between 0 255 Id) Id)) "141.214.125." , expectPE (PresentT 9) $ pl @((Wrap _ Id *** Wrap (SG.Sum _) Id) >> Sapa >> Unwrap Id) (4,5) , expectPE (PresentT (SG.Sum 9)) $ pl @((Wrap _ Id *** Wrap _ Id) >> Sapa) (4,5) , expectPE (PresentT 9) $ pl @(Sapa' (SG.Sum _) >> Unwrap Id) (4,5) @@ -323,10 +323,10 @@ , expectPE (FailT "len is bad") $ pl @Ip6Test "FE80::203:Baff:FE77:326FF" , expectPE (FailT "not a hex") $ pl @Ip6Test "FE80::203:Baff:GE77:326F" , expectPE (FailT "count is bad") $ pl @Ip6Test "FE80::203:Baff:FE77:326F:::::" - , expectPE (PresentT 65504) $ pl @(ReadBaseInt 16 Id) "fFe0" + , expectPE (PresentT 65504) $ pl @(ReadBase Int 16 Id) "fFe0" , expectPE (PresentT "ffe0") $ pl @(ShowBase 16 Id) 65504 - , expectPE (FailT "invalid base 22") $ pl @(ReadBaseInt 22 Id) "zzz" - , expectPE (PresentT ("ffe0","fFe0")) $ pl @((ReadBaseInt 16 Id &&& Id) >> First (ShowBase 16 Id)) "fFe0" + , expectPE (FailT "invalid base 22") $ pl @(ReadBase Int 22 Id) "zzz" + , expectPE (PresentT ("ffe0","fFe0")) $ pl @((ReadBase Int 16 Id &&& Id) >> First (ShowBase 16 Id)) "fFe0" , expectPE FalseT $ pl @(Id == "Abc") "abc" , expectPE TrueT $ pl @("Abc" ==~ Id) "abc" , expectPE (PresentT LT) $ pl @("Abc" ==! Id) "abc" @@ -349,19 +349,19 @@ , expectPE (PresentT [True,True,True,True,True,True,True,True,True,True]) $ pl @(Map (GuardSimple (Ge 1) >> 'True) Id) [1::Int .. 10] , expectPE (PresentT [4,5,6]) $ pl @(ScanN 2 Id (Succ Id)) 4 , expectPE (PresentT [4,4,4,4,4,4]) $ pl @(ScanN 5 Id Id) 4 - , expectPE (PresentT [1,2,3,244]) $ pl @(Rescan Ip4RE Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ip4op) "1.2.3.244" - , expectPE (FailT "octet 1 out of range 0-255 found 256") $ pl @(Rescan Ip4RE Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ip4op) "1.256.3.244" - , expectPE (FailT "Guards: invalid length:expected 4 but found 5") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBaseInt 10 Id) Id >> Ip4op) "1.22.244.66.77" + , expectPE (PresentT [1,2,3,244]) $ pl @(Rescan Ip4RE Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id) >> Ip4op) "1.2.3.244" + , expectPE (FailT "octet 1 out of range 0-255 found 256") $ pl @(Rescan Ip4RE Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id) >> Ip4op) "1.256.3.244" + , expectPE (FailT "Guards:invalid length(5) expected 4") $ pl @(Rescan "(\\d+)\\.?" Id >> ConcatMap (Snd Id) Id >> Map (ReadBase Int 10 Id) Id >> Ip4op) "1.22.244.66.77" , expectPE (PresentT (SG.Sum 123)) $ pl @(JustDef (MEmptyT _) Id) (Just (SG.Sum 123)) , expectPE (PresentT (SG.Sum 0)) $ pl @(JustDef (MEmptyT _) Id) (Nothing @(SG.Sum _)) , expectPE (PresentT (636 % 5)) $ pl @((ToRational 123 &&& Id) >> Fst Id + Snd Id) 4.2 , expectPE (PresentT 127) $ pl @((123 &&& Id) >> Fst Id + Snd Id) 4 - , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> ReadBaseInt 16 Id >> Succ Id) "\\xfF" - , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x(.{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> ReadBaseInt 16 Id >> Succ Id) "\\xfF" - , expectPE (PresentT (("fF",(255,"ff")),False)) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> (Id &&& (ReadBaseInt 16 Id >> (Id &&& ShowBase 16 Id))) >> (Id &&& ((Id *** Snd Id) >> Fst Id == Snd Id))) "\\xfF" - , expectPE (PresentT [1,2,4,0]) $ pl @(Do '[Succ Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8 Id) Id]) 1239 - , expectPE (FailT "invalid base 8") $ pl @(Do '[Pred Id,Id,ShowP Id,Ones Id,Map (ReadBaseInt 8 Id) Id]) 1239 - , expectPE (PresentT 47) $ pl @(ReadBaseInt 2 Id) "101111" + , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> ReadBase Int 16 Id >> Succ Id) "\\xfF" + , expectPE (PresentT 256) $ pl @(Rescan "(?i)^\\\\x(.{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> ReadBase Int 16 Id >> Succ Id) "\\xfF" + , expectPE (PresentT (("fF",(255,"ff")),False)) $ pl @(Rescan "(?i)^\\\\x([0-9a-f]{2})$" Id >> OneP Id >> Snd Id >> OneP Id >> (Id &&& (ReadBase Int 16 Id >> (Id &&& ShowBase 16 Id))) >> (Id &&& ((Id *** Snd Id) >> Fst Id == Snd Id))) "\\xfF" + , expectPE (PresentT [1,2,4,0]) $ pl @(Do '[Succ Id,Id,ShowP Id,Ones Id,Map (ReadBase Int 8 Id) Id]) 1239 + , expectPE (FailT "invalid base 8") $ pl @(Do '[Pred Id,Id,ShowP Id,Ones Id,Map (ReadBase Int 8 Id) Id]) 1239 + , expectPE (PresentT 47) $ pl @(ReadBase Int 2 Id) "101111" , expectPE (PresentT [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ]) $ pl @(ScanN 2 Id (Succ Id) >> PadR 10 (MEmptyT Ordering) Id) LT , expectPE (PresentT 12) $ pl @('This Id) (This 12) , expectPE (FailT "'This found That") $ pl @('This Id) (That @() 12) @@ -393,12 +393,12 @@ , expectPE (PresentT "hhhhh") $ pl @(Do '["abc", "Def", "ggg", "hhhhh"]) () , expectPE (PresentT GT) $ pl @(Do '[ 'LT, 'EQ, 'GT ]) () , expectPE (PresentT (-3 % 1)) $ pl @(Do '[4 % 4,22 % 1 ,12 -% 4]) () - , expectPE (PresentT [10,2,5]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 11, Between 1 4,Between 3 5]) [10::Int,2,5] - , expectPE (PresentT [31,11,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id) >> Ddmmyyyyval) "31-11-1999" - , expectPE (PresentT [31,11,1999]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,1999::Int] - , expectPE (FailT "Guards: invalid length:expected 3 but found 2") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11::Int] - , expectPE (FailT "guard(1) 13 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,13,1999::Int] - , expectPE (FailT "guard(0) 0 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [0,44,1999::Int] + , expectPE (PresentT [10,2,5]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 11 Id, Between 1 4 Id,Between 3 5 Id]) [10::Int,2,5] + , expectPE (PresentT [31,11,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id) >> Ddmmyyyyop) "31-11-1999" + , expectPE (PresentT [31,11,1999]) $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id]) [31,11,1999::Int] + , expectPE (FailT "Guards:invalid length(2) expected 3") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id]) [31,11::Int] + , expectPE (FailT "guard(1) 13 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id]) [31,13,1999::Int] + , expectPE (FailT "guard(0) 0 is out of range") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id]) [0,44,1999::Int] , expectPE (PresentT (fromGregorian 1999 11 30)) $ pl @(ReadP Day Id) "1999-11-30" , expectPE (FailT "ReadP Day (1999-02-29)") $ pl @(ReadP Day Id) "1999-02-29" , expectPE (PresentT (TimeOfDay 14 59 20)) $ pl @(ReadP TimeOfDay Id) "14:59:20" @@ -406,12 +406,12 @@ , expectPE (FailT "ParseTimeP TimeOfDay (%H:%M%S) failed to parse") $ pl @(ParseTimeP TimeOfDay "%H:%M%S" Id) "14:04:61" , expectPE (PresentT (TimeOfDay 23 13 59)) $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay Id) "23:13:59" , expectPE (FailT "hh:mm:ss regex failed") $ pl @(Guard "hh:mm:ss regex failed" (Re HmsRE Id) >> ReadP TimeOfDay Id) "23:13:60" - , expectPE (FailT "Guards: invalid length:expected 3 but found 5") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31, Between 1 12, Between 1990 2050]) [31,11,2000,1,2::Int] + , expectPE (FailT "Guards:invalid length(5) expected 3") $ pl @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 1 31 Id, Between 1 12 Id, Between 1990 2050 Id]) [31,11,2000,1,2::Int] , expectPE (PresentT [0,0,0,0,0,0,0,1,2,3]) $ pl @(PadL 10 0 Id) [1..3] , expectPE (PresentT (124,["1","2","2"])) $ pl @('Left Id >> (Succ Id &&& (Pred Id >> ShowP Id >> Ones Id))) (Left 123) - , expectPE (PresentT [1,2,3,4]) $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3,4::Int] - , expectPE (FailT "Guards: invalid length:expected 4 but found 5") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3,4,5::Int] - , expectPE (FailT "Guards: invalid length:expected 4 but found 3") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255)) [1,2,3::Int] + , expectPE (PresentT [1,2,3,4]) $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255 Id)) [1,2,3,4::Int] + , expectPE (FailT "Guards:invalid length(5) expected 4") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255 Id)) [1,2,3,4,5::Int] + , expectPE (FailT "Guards:invalid length(3) expected 4") $ pl @(GuardsN (PrintT "guard(%d) %d is out of range" Id) 4 (Between 0 255 Id)) [1,2,3::Int] , expectPE (PresentT (readNote @UTCTime "failed to read utc" "1999-01-01 12:12:12 UTC")) $ pl @(ParseTimeP UTCTime "%F %T" Id) "1999-01-01 12:12:12" , expectPE (PresentT 123) $ pl @(JustDef 0 Id) (Just 123) , expectPE (PresentT 0) $ pl @(JustDef 0 Id) Nothing @@ -489,8 +489,8 @@ , expectPE (PresentT 99) $ pl @(JustDef 99 Id) Nothing , expectPE (PresentT (-99)) $ pl @(MaybeIn (99 -% 1 ) Id) Nothing , expectPE (PresentT (-99)) $ pl @(JustDef (99 -% 1 ) Id) Nothing - , expectPE (PresentT [1,2,3,4,12]) $ pl @(ParaN 5 (Guard "0-255" (Between 0 255))) [1,2,3,4,12] - , expectPE (FailT "0-255") $ pl @(ParaN 5 (Guard "0-255" (Between 0 255))) [1,2,3,400,12] + , expectPE (PresentT [1,2,3,4,12]) $ pl @(ParaN 5 (Guard "0-255" (Between 0 255 Id))) [1,2,3,4,12] + , expectPE (FailT "0-255") $ pl @(ParaN 5 (Guard "0-255" (Between 0 255 Id))) [1,2,3,400,12] , expectPE (PresentT ["141","021","003","000"]) $ pl @(ParaN 4 (PrintF "%03d" Id)) [141,21,3,0::Int] -- need to fill in the types for both even in ghci @@ -511,8 +511,8 @@ , expectPE (PresentT "0004d2") $ pl @(PrintF "%06x" Id) (1234 :: Int) , expectPE (PresentT (Left 123)) $ pl @(Pure (Either String) Id >> Swap) 123 , expectPE (PresentT [13,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadP Int Id) (Snd Id)) "13-02-1999" - , expectPE (PresentT [3,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyval) "03-02-1999" - , expectPE (FailT "guard(1) month 13 is out of range") $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyval) "12-13-1999" + , expectPE (PresentT [3,2,1999]) $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyop) "03-02-1999" + , expectPE (FailT "month 13 is out of range") $ pl @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadP Int Id) (Snd Id) >> Ddmmyyyyop) "12-13-1999" , expectPE (PresentT [[1],[2,3,4],[5,6,7,8],[9,10,11,12]]) $ pl @(SplitAts '[1,3,4] Id) [1..12] , expectPE (PresentT [[1,2,3],[4]]) $ pl @(SplitAts '[3,1,1,1] Id >> Filter (Not Null) Id) [1..4] , expectPE (PresentT 1) $ pl @(Msg (PrintF "digits=%d" Len) (Head Id)) [1..4] @@ -542,11 +542,11 @@ , expectPE (PresentT 23) $ pl @(Fst Id + Last (Snd Id)) (10,[12,13]) , expectPE (PresentT (-1,12)) $ pl @(DivMod (9 - Fst Id) (Last (Snd Id))) (10,[12,13]) , expectPE (PresentT [True,False,False,True]) $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999] - , expectPE (FailT "Para: invalid length:expected 4 but found 3") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99] - , expectPE (FailT "Para: invalid length:expected 4 but found 7") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999,1,1,2] + , expectPE (FailT "Para:invalid length(3) expected 4") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99] + , expectPE (FailT "Para:invalid length(7) expected 4") $ pl @(Para '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999,1,1,2] , expectPE (FailT "guard(1) err 002") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99,-999] - , expectPE (FailT "Guards: invalid length:expected 4 but found 3") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99] - , expectPE (FailT "Guards: invalid length:expected 4 but found 7") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999,1,1,2] + , expectPE (FailT "Guards:invalid length(3) expected 4") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'False, Lt 2 ]) [1,2,-99] + , expectPE (FailT "Guards:invalid length(7) expected 4") $ pl @(GuardsQuick (PrintT "guard(%d) err %03d" Id) '[ W 'True, Ge 12, W 'True, Lt 2 ]) [1,22,-99,-999,1,1,2] , expectPE TrueT $ pl @(Fst Id /= Snd Id) ("ab","xyzabw") , expectPE FalseT $ pl @(Fst Id == Snd Id) ("ab","xyzabw") , expectPE (PresentT 157) $ pl @(Fst Id * (Snd Id >> Fst Id) + (Snd Id >> Snd Id) `Div` 2) (12,(13,3)) @@ -796,8 +796,8 @@ , expectPE (PresentT (True,11)) $ pl @(Just Uncons >> FoldL (If (Fst (Fst Id)) (If (Snd (Fst Id) < Snd Id) '( 'True,Snd Id) '( 'False, Snd Id)) (Fst Id)) '( 'True,Fst Id) (Snd Id)) [-10,2,3,4,10,11] , expectPE (FailT "pivot=5 value=3(2)") $ pl @(SortBy (If (Fst Id==5 && Snd Id==3) (Failt _ (PrintT "pivot=%d value=%d" Id)) 'GT) (Snd Id)) ((), [5,7,3,1,6,2,1,3]) , expectPE (PresentT [1,1,2,3,3,5,6,7]) $ pl @(SortBy (If (Fst Id==50 && Snd Id==3) (Failt _ (PrintT "pivot=%d value=%d" Id)) (OrdA Id)) (Snd Id)) ((), [5,7,3,1,6,2,1,3]) - , expectPE TrueT $ pl @(Between' (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),3) - , expectPE FalseT $ pl @(Between' (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),10) + , expectPE TrueT $ pl @(Between (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),3) + , expectPE FalseT $ pl @(Between (Fst Id >> Fst Id) (Fst Id >> Snd Id) (Snd Id)) ((1,4),10) , expectPE (FailT "no match on [03/29/0x7]") $ pl @(Map (ParseTimes Day '["%Y-%m-%d", "%m/%d/%y", "%b %d %Y"] Id) Id) ["2001-01-01", "Jan 24 2009", "03/29/0x7"] , expectPE (PresentT [readNote @Day "invalid day" "2001-01-01", readNote @Day "invalid day" "2009-01-24", readNote @Day "invalid day" "2007-03-29"]) $ pl @(Map (ParseTimes Day '["%Y-%m-%d", "%m/%d/%y", "%b %d %Y"] Id) Id) ["2001-01-01", "Jan 24 2009", "03/29/07"] @@ -812,7 +812,7 @@ , expectPE (PresentT "other") $ pl @(Case "other" '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15 , expectPE (PresentT "151515") $ pl @(Case (ShowP (Fst Id) >> Id <> Id <> Id) '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15 , expectPE (FailT "Case:no match") $ pl @(Case' '[Same 1, Same 2, Same 3] '["eq1","eq2","eq3"] Id) 15 - , expectPE (FailT "no match for -012") $ pl @(Case'' (PrintF "no match for %04d" Id) '[Between 0 5, Same 6, Between 7 10] '[ 'LT, 'EQ, 'GT] Id) (-12) + , expectPE (FailT "no match for -012") $ pl @(Case'' (PrintF "no match for %04d" Id) '[Between 0 5 Id, Same 6, Between 7 10 Id] '[ 'LT, 'EQ, 'GT] Id) (-12) , expectPE (PresentT [Left 1,Left 2,Right "fizz",Left 4,Right "buzz",Right "fizz",Left 7,Left 8,Right "fizz",Right "buzz",Left 11,Right "fizz",Left 13,Left 14,Right "fizzbuzz"]) $ pl @(Map Fizzbuzz''' Id) [1..15] , expectPE (PresentT (Left 'x')) $ pl @(EitherBool (Fst Id > 10) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (7,('x',99)) , expectPE (PresentT (Right 99)) $ pl @(EitherBool (Fst Id > 10) (Snd Id >> Fst Id) (Snd Id >> Snd Id)) (11,('x',99)) @@ -852,7 +852,7 @@ type Fizzbuzzs3 = Map (Fizzbuzz >> If (Snd Id == "") (MkLeft' (Snd Id) (Fst Id)) (MkRight' (Fst Id) (Snd Id))) Id type Ip6Test = Resplit ":" Id - >> Guard "count is bad" (Between' 0 8 Len) + >> Guard "count is bad" (Between 0 8 Len) >> Guard "not a hex" (All (All (Elem Id "abcdefABCDEF0123456789") Id) Id) >> Guard "len is bad" (All (Len >> Le 4) Id)
test/TestRefined.hs view
@@ -44,7 +44,7 @@ namedTests = [ testCase "always true" $ (@?=) ($$(refinedTH 7) :: Refined 'True Int) (unsafeRefined 7) - , testCase "between5and9" $ (@?=) ($$(refinedTH 7) :: Refined (Between 5 9) Int) (unsafeRefined 7) + , testCase "between5and9" $ (@?=) ($$(refinedTH 7) :: Refined (Between 5 9 Id) Int) (unsafeRefined 7) ] unnamedTests :: [IO ()] @@ -53,14 +53,14 @@ , (@?=) (unsafeRefined @((Len == 4) && Luhn Id) [1,2,3,0]) $$(refinedTH [1,2,3,0]) , (@?=) (unsafeRefined @(Not ((Len == 4) && Luhn Id)) [1,2,3,1]) $$(refinedTH [1,2,3,1]) - , (@?=) [(unsafeRefined 7, "")] (reads @(Refined (Between 2 10) Int) "Refined {unRefined = 7}") - , (@?=) [] (reads @(Refined (Between 2 10) Int) "Refined {unRefined = 0}") + , (@?=) [(unsafeRefined 7, "")] (reads @(Refined (Between 2 10 Id) Int) "Refined {unRefined = 7}") + , (@?=) [] (reads @(Refined (Between 2 10 Id) Int) "Refined {unRefined = 0}") , (@?=) [(unsafeRefined "abcaaaabb", "")] (reads @(Refined (Re "^[abc]+$" Id) String) "Refined {unRefined = \"abcaaaabb\"}") , (@?=) [] (reads @(Refined (Re "^[abc]+$" Id) String) "Refined {unRefined = \"abcaaaabbx\"}") - , expectJ (Left ["Error in $: Refined:FalseP"]) (toFrom (unsafeRefined @(Between 4 7 || Gt 14) 12)) - , expectJ (Right (unsafeRefined 22)) (toFrom (unsafeRefined @(Between 4 7 || Gt 14) 22)) - , expectJ (Left ["Error in $: Refined:FailP \"someval\""]) (toFrom (unsafeRefined @(Between 4 7 || Gt 14 || Failt _ "someval") 12)) + , expectJ (Left ["Error in $: Refined:FalseP"]) (toFrom (unsafeRefined @(Between 4 7 Id || Gt 14) 12)) + , expectJ (Right (unsafeRefined 22)) (toFrom (unsafeRefined @(Between 4 7 Id || Gt 14) 22)) + , expectJ (Left ["Error in $: Refined:FailP \"someval\""]) (toFrom (unsafeRefined @(Between 4 7 Id || Gt 14 || Failt _ "someval") 12)) , (fst <$> unRavelT (tst2 ol 10 200)) >>= (@?= Right (10,200)) , (fst <$> unRavelT (tst2 ol 11 12)) >>= (@?= Left "FalseP") @@ -72,18 +72,18 @@ allProps :: [TestTree] allProps = [ - testProperty "readshow" $ forAll (arbRefined @(Between 10 45) ol) (\r -> read @(Refined (Between 10 45) Int) (show r) === r) - , testProperty "jsonroundtrip" $ forAll (arbRefined @(Between 10 45) ol) (\r -> testRefinedJ @(Between 10 45) ol (unRefined r) === Right r) + testProperty "readshow" $ forAll (arbRefined @(Between 10 45 Id) ol) (\r -> read @(Refined (Between 10 45 Id) Int) (show r) === r) + , testProperty "jsonroundtrip" $ forAll (arbRefined @(Between 10 45 Id) ol) (\r -> testRefinedJ @(Between 10 45 Id) ol (unRefined r) === Right r) ] tst1 :: Monad m => POpts -> Int -> Int -> RefinedT m (Int,Int) -tst1 opts i j = withRefinedT @(Between 2 11) opts i - $ \x -> withRefinedT @(Between 200 211) opts j +tst1 opts i j = withRefinedT @(Between 2 11 Id) opts i + $ \x -> withRefinedT @(Between 200 211 Id) opts j $ \y -> return (unRefined x, unRefined y) tst2 :: MonadIO m => POpts -> Int -> Int -> RefinedT m (Int,Int) -tst2 opts i j = withRefinedTIO @(Between 2 11) opts i - $ \x -> withRefinedTIO @(Stderr "startio..." |> Between 200 211 >| Stderr "...endio") opts j +tst2 opts i j = withRefinedTIO @(Between 2 11 Id) opts i + $ \x -> withRefinedTIO @(Stderr "startio..." |> Between 200 211 Id >| Stderr "...endio") opts j $ \y -> return (unRefined x, unRefined y) -- roundtrip tojson then fromjson
test/TestRefined2.hs view
@@ -52,7 +52,7 @@ , testCase "datetime utctime" $ (@?=) ($$(refined2TH "2019-01-04 23:00:59") :: MakeR2 (DateTime1 UTCTime)) (unsafeRefined2 (read "2019-01-04 23:00:59 UTC") "2019-01-04 23:00:59") , testCase "datetime localtime" $ (@?=) ($$(refined2TH "2019-01-04 09:12:30") :: MakeR2 (DateTime1 LocalTime)) (unsafeRefined2 (read "2019-01-04 09:12:30") "2019-01-04 09:12:30") , testCase "hms" $ (@?=) ($$(refined2TH "12:0:59") :: MakeR2 Hms) (unsafeRefined2 [12,0,59] "12:0:59") - , testCase "between5and9" $ (@?=) ($$(refined2TH "7") :: Refined2 (ReadP Int Id) (Between 5 9) String) (unsafeRefined2 7 "7") + , testCase "between5and9" $ (@?=) ($$(refined2TH "7") :: Refined2 (ReadP Int Id) (Between 5 9 Id) String) (unsafeRefined2 7 "7") , testCase "ssn" $ (@?=) ($$(refined2TH "123-45-6789") :: MakeR2 Ssn) (unsafeRefined2 [123,45,6789] "123-45-6789") , testCase "base16" $ (@?=) ($$(refined2TH "12f") :: MakeR2 (BaseN 16)) (unsafeRefined2 303 "12f") , testCase "daten1" $ (@?=) ($$(refined2TH "June 25 1900") :: MakeR2 DateN) (unsafeRefined2 (read "1900-06-25") "June 25 1900") @@ -63,8 +63,8 @@ unnamedTests :: [IO ()] unnamedTests = [ - (@?=) [(unsafeRefined2 255 "ff", "")] (reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255) String) "Refined2 {r2In = 255, r2Out = \"ff\"}") -- escape quotes cos read instance for String - , (@?=) [] (reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255) String) "Refined2 {r2In = 256, r2Out = \"100\"}") + (@?=) [(unsafeRefined2 255 "ff", "")] (reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255 Id) String) "Refined2 {r2In = 255, r2Out = \"ff\"}") -- escape quotes cos read instance for String + , (@?=) [] (reads @(Refined2 (ReadBase Int 16 Id) (Between 0 255 Id) String) "Refined2 {r2In = 256, r2Out = \"100\"}") , (@?=) [(unsafeRefined2 (-1234) "-4d2", "")] (reads @(Refined2 (ReadBase Int 16 Id) (Id < 0) String) "Refined2 {r2In = -1234, r2Out = \"-4d2\"}") , (@?=) (unsafeRefined2 [1,2,3,4] "1.2.3.4") ($$(refined2TH "1.2.3.4") :: Ip4R) @@ -84,12 +84,12 @@ , expect2 (Left $ XF "Regex no results") $ eval2 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id)) - @((Len == 4) && All (Between 0 255) Id) + @((Len == 4) && All (Between 0 255 Id) Id) ol "1.21.x31.4" , expect2 (Right $ unsafeRefined2 [1,21,31,4] "1.21.31.4") $ eval2 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id)) - @((Len == 4) && All (Between 0 255) Id) + @((Len == 4) && All (Between 0 255 Id) Id) ol "1.21.31.4" , expect2 (Left $ XTFalse (-6.5) "(-13) % 2 > (-7) % 3") @@ -105,7 +105,7 @@ $ eval2 @Id @(Gt (7 -% 3)) ol 4.123 , expect2 (Right $ unsafeRefined2 [1,2,3,4] "1.2.3.4") - $ eval2 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(All (Between 0 255) Id && (Len == 4)) ol "1.2.3.4" + $ eval2 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(All (Between 0 255 Id) Id && (Len == 4)) ol "1.2.3.4" , expect2 (Left $ XTFalse [0,0,0,291,1048319,4387,17,1] "True && False | (out of bounds:All(8) i=4 (1048319 <= 65535))") $ eval2 @Ip6ip @Ip6op ol "123:Ffeff:1123:11:1" @@ -115,19 +115,19 @@ , expect2 (Right $ unsafeRefined2 [123,45,6789] "123-45-6789") $ eval2 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) @(Guard "expected 3" (Len == 3) - >> Guard "3 digits" (Ix' 0 >> Between 0 999) - >> Guard "2 digits" (Ix' 1 >> Between 0 99) - >> Guard "4 digits" (Ix' 2 >> Between 0 9999) + >> Guard "3 digits" (Ix' 0 >> Between 0 999 Id) + >> Guard "2 digits" (Ix' 1 >> Between 0 99 Id) + >> Guard "4 digits" (Ix' 2 >> Between 0 9999 Id) >> 'True ) ol "123-45-6789" , expect2 (Right $ unsafeRefined2 [123,45,6789] "123-45-6789") $ eval2 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999 Id, Between 0 99 Id, Between 0 9999 Id] >> 'True) ol "123-45-6789" , expect2 (Left $ XTFalse [0,0,0,291,1048319,4387,17,1] "True && False | (out of bounds:All(8) i=4 (1048319 <= 65535))") @@ -151,19 +151,19 @@ ol "123::Ffff:::11" , expect2 (Right $ unsafeRefined2 [31,11,1999] "31-11-1999") - $ eval2 @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(Ddmmyyyyval >> 'True) + $ eval2 @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(Ddmmyyyyop >> 'True) ol "31-11-1999" , expect2 (Right $ unsafeRefined2 [123,45,6789] "123-45-6789") $ eval2 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999 Id, Between 0 99 Id, Between 0 9999 Id] >> 'True) ol "123-45-6789" , expect2 (Right $ unsafeRefined2 [1,2,3,4] "1.2.3.4") $ eval2P ip4 ol "1.2.3.4" , expect2 (Left $ XF "ReadP Int (3x)") $ eval2P ip4 ol "1.2.3x.4" - , expect2 (Left $ XTFalse [1,2,3,4,5] "Bools: invalid length:expected 4 but found 5") $ eval2P ip4' ol "1.2.3.4.5" - , expect2 (Left $ XTF [1,2,3,4,5] "Guards: invalid length:expected 4 but found 5") $ eval2P ip4 ol "1.2.3.4.5" - , expect2 (Left $ XTFalse [1,2,300,4] "Bools(2) [octet 2 out of range 0-255 found 300] (300 <= 255)") $ eval2P ip4' ol "1.2.300.4" + , expect2 (Left $ XTFalse [1,2,3,4,5] "Bools:invalid length(5) expected 4") $ eval2P ip4' ol "1.2.3.4.5" + , expect2 (Left $ XTF [1,2,3,4,5] "Guards:invalid length(5) expected 4") $ eval2P ip4 ol "1.2.3.4.5" + , expect2 (Left $ XTFalse [1,2,300,4] "Bool(2) [octet 2 out of range 0-255 found 300] (300 <= 255)") $ eval2P ip4' ol "1.2.300.4" , expect2 (Left $ XTF [1,2,300,4] "octet 2 out of range 0-255 found 300") $ eval2P ip4 ol "1.2.300.4" , expect2 (Right $ unsafeRefined2 [1,2,3,4,5,6,7,8,9,0,3] "12345678903") $ eval2P cc11 ol "12345678903" , expect2 (Left $ XTFalse [1,2,3,4,5,6,7,8,9,0,1] "") $ eval2P cc11 oz "12345678901" @@ -174,7 +174,7 @@ -- better to use Guard for op boolean check cos we get better errormessages -- 1. packaged up as a promoted tuple -type Tst3 = '(Map (ReadP Int Id) (Resplit "\\." Id), (Len == 4) && All (Between 0 255) Id, String) +type Tst3 = '(Map (ReadP Int Id) (Resplit "\\." Id), (Len == 4) && All (Between 0 255 Id) Id, String) www1, www2 :: String -> Either Msg2 (MakeR2 Tst3) www1 = prtEval2P (Proxy @Tst3) o2 @@ -185,7 +185,7 @@ -- 2. packaged as a proxy tst3 :: Proxy '(Map (ReadP Int Id) (Resplit "\\." Id) - ,(Len == 4) && All (Between 0 255) Id + ,(Len == 4) && All (Between 0 255 Id) Id ,String) tst3 = Proxy @@ -193,13 +193,13 @@ -- 3. direct ww3 :: String -> Either Msg2 (Refined2 (Map (ReadP Int Id) (Resplit "\\." Id)) - ((Len == 4) && All (Between 0 255) Id) + ((Len == 4) && All (Between 0 255 Id) Id) String) ww3 = prtEval2 o2 {- ww3 = prtEval2 @(Map (ReadP Int Id) (Resplit "\\." Id)) - @((Len == 4) && All (Between 0 255)) + @((Len == 4) && All (Between 0 255 Id)) o2 -} data G4 = G4 { g4Age :: MakeR2 Age @@ -212,7 +212,7 @@ type Ip9 = '( Map (ReadP Int Id) (Resplit "\\." Id) -- split String on "." then convert to [Int] - ,Len == 4 && All (Between 0 255) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255 + ,Len == 4 && All (Between 0 255 Id) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255 ,String -- input type is string which is also the output type ) @@ -227,13 +227,13 @@ -- prtRefinedT tst1a tst1a :: Monad m => POpts -> RefinedT m ((Int,String),(Int,String)) -tst1a opts = withRefined2T @(ReadBase Int 16 Id) @(Between 100 200) @String opts "a3" +tst1a opts = withRefined2T @(ReadBase Int 16 Id) @(Between 100 200 Id) @String opts "a3" $ \r1 -> withRefined2T @(ReadP Int Id) @'True @String opts "12" $ \r2 -> return ((r2In r1, r2Out r1), (r2In r2, r2Out r2)) -- prtRefinedTIO tst2a tst2a :: MonadIO m => POpts -> RefinedT m ((Int,String),(Int,String)) -tst2a opts = withRefined2TIO @(ReadBase Int 16 Id) @(Stderr "start" |> Between 100 200 >| Stdout "end") @String opts "a3" +tst2a opts = withRefined2TIO @(ReadBase Int 16 Id) @(Stderr "start" |> Between 100 200 Id >| Stdout "end") @String opts "a3" $ \r1 -> withRefined2TIO @(ReadP Int Id) @'True @String opts "12" $ \r2 -> return ((r2In r1, r2Out r1), (r2In r2, r2Out r2))
test/TestRefined3.hs view
@@ -57,7 +57,7 @@ , testCase "datetime utctime" $ (@?=) ($$(refined3TH "2019-01-04 23:00:59") :: MakeR3 (DateTime1 UTCTime)) (unsafeRefined3 (read "2019-01-04 23:00:59 UTC") "2019-01-04 23:00:59") , testCase "datetime localtime" $ (@?=) ($$(refined3TH "2019-01-04 09:12:30") :: MakeR3 (DateTime1 LocalTime)) (unsafeRefined3 (read "2019-01-04 09:12:30") "2019-01-04 09:12:30") , testCase "hms" $ (@?=) ($$(refined3TH "12:0:59") :: MakeR3 Hms) (unsafeRefined3 [12,0,59] "12:00:59") - , testCase "between5and9" $ (@?=) ($$(refined3TH "7") :: Refined3 (ReadP Int Id) (Between 5 9) (PrintF "%03d" Id) String) (unsafeRefined3 7 "007") + , testCase "between5and9" $ (@?=) ($$(refined3TH "7") :: Refined3 (ReadP Int Id) (Between 5 9 Id) (PrintF "%03d" Id) String) (unsafeRefined3 7 "007") , testCase "ssn" $ (@?=) ($$(refined3TH "123-45-6789") :: MakeR3 Ssn) (unsafeRefined3 [123,45,6789] "123-45-6789") , testCase "base16" $ (@?=) ($$(refined3TH "12f") :: MakeR3 (BaseN 16)) (unsafeRefined3 303 "12f") , testCase "daten1" $ (@?=) ($$(refined3TH "June 25 1900") :: MakeR3 DateN) (unsafeRefined3 (read "1900-06-25") "1900-06-25") @@ -69,8 +69,8 @@ unnamedTests :: [IO ()] unnamedTests = [ - (@?=) [(unsafeRefined3 255 "ff", "")] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 255, r3Out = \"ff\"}") -- escape quotes cos read instance for String - , (@?=) [] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255) (ShowBase 16 Id) String) "Refined3 {r3In = 256, r3Out = \"100\"}") + (@?=) [(unsafeRefined3 255 "ff", "")] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255 Id) (ShowBase 16 Id) String) "Refined3 {r3In = 255, r3Out = \"ff\"}") -- escape quotes cos read instance for String + , (@?=) [] (reads @(Refined3 (ReadBase Int 16 Id) (Between 0 255 Id) (ShowBase 16 Id) String) "Refined3 {r3In = 256, r3Out = \"100\"}") , (@?=) [(unsafeRefined3 (-1234) "-4d2", "")] (reads @(Refined3 (ReadBase Int 16 Id) (Id < 0) (ShowBase 16 Id) String) "Refined3 {r3In = -1234, r3Out = \"-4d2\"}") , (@?=) (unsafeRefined3 [1,2,3,4] "001.002.003.004") ($$(refined3TH "1.2.3.4") :: Ip4R) @@ -90,13 +90,13 @@ , expect3 (Left $ XF "Regex no results") $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id)) - @((Len == 4) && All (Between 0 255) Id) + @((Len == 4) && All (Between 0 255 Id) Id) @(PrintL 4 "%03d.%03d.%03d.%03d" Id) ol "1.21.x31.4" , expect3 (Right $ unsafeRefined3 [1,21,31,4] "001.021.031.004") $ eval3 @(Rescan Ip4RE Id >> HeadFail "failedn" Id >> Map (ReadP Int Id) (Snd Id)) - @((Len == 4) && All (Between 0 255) Id) + @((Len == 4) && All (Between 0 255 Id) Id) @(PrintL 4 "%03d.%03d.%03d.%03d" Id) ol "1.21.31.4" @@ -114,7 +114,7 @@ $ eval3 @Id @(Gt (7 -% 3)) @(4123 % 1000) ol 4.123 , expect3 (Right $ unsafeRefined3 [1,2,3,4] "") - $ eval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(All (Between 0 255) Id && (Len == 4)) @"" + $ eval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) @(All (Between 0 255 Id) Id && (Len == 4)) @"" ol "1.2.3.4" , expect3 (Left $ XTFalse [0,0,0,291,1048319,4387,17,1] "True && False | (out of bounds:All(8) i=4 (1048319 <= 65535))") @@ -125,19 +125,19 @@ , expect3 (Right $ unsafeRefined3 [123,45,6789] "def") $ eval3 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) @(Guard "expected 3" (Len == 3) - >> Guard "3 digits" (Ix' 0 >> Between 0 999) - >> Guard "2 digits" (Ix' 1 >> Between 0 99) - >> Guard "4 digits" (Ix' 2 >> Between 0 9999) + >> Guard "3 digits" (Ix' 0 >> Between 0 999 Id) + >> Guard "2 digits" (Ix' 1 >> Between 0 99 Id) + >> Guard "4 digits" (Ix' 2 >> Between 0 9999 Id) >> 'True ) @"def" ol "123-45-6789" , expect3 (Right $ unsafeRefined3 [123,45,6789] "xyz") $ eval3 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999 Id, Between 0 99 Id, Between 0 9999 Id] >> 'True) @"xyz" ol "123-45-6789" @@ -158,21 +158,21 @@ ol "123::Ffff:::11" , expect3 (Right $ unsafeRefined3 [31,11,1999] "xyz") - $ eval3 @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(Ddmmyyyyval >> 'True) + $ eval3 @(Rescan DdmmyyyyRE Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(Ddmmyyyyop >> 'True) @"xyz" ol "31-11-1999" , expect3 (Right $ unsafeRefined3 [123,45,6789] "xyz") $ eval3 - @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBaseInt 10 Id) (Snd Id)) - @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999, Between 0 99, Between 0 9999] >> 'True) + @(Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> OneP Id >> Map (ReadBase Int 10 Id) (Snd Id)) + @(GuardsQuick (PrintT "guard(%d) %d is out of range" Id) '[Between 0 999 Id, Between 0 99 Id, Between 0 9999 Id] >> 'True) @"xyz" ol "123-45-6789" , expect3 (Right $ unsafeRefined3 [1,2,3,4] "001.002.003.004") $ eval3P ip4 ol "1.2.3.4" , expect3 (Left $ XF "ReadP Int (3x)") $ eval3P ip4 ol "1.2.3x.4" - , expect3 (Left $ XTF [1,2,3,4,5] "Guards: invalid length:expected 4 but found 5") $ eval3P ip4 ol "1.2.3.4.5" + , expect3 (Left $ XTF [1,2,3,4,5] "Guards:invalid length(5) expected 4") $ eval3P ip4 ol "1.2.3.4.5" , expect3 (Left $ XTF [1,2,300,4] "octet 2 out of range 0-255 found 300") $ eval3P ip4 ol "1.2.300.4" - , expect3 (Left (XTFalse [1,2,300,4] "Bools(2) [octet 2 out of range 0-255 found 300] (300 <= 255)")) $ eval3P ip4' ol "1.2.300.4" + , expect3 (Left (XTFalse [1,2,300,4] "Bool(2) [octet 2 out of range 0-255 found 300] (300 <= 255)")) $ eval3P ip4' ol "1.2.300.4" , expect3 (Right $ unsafeRefined3 [1,2,3,4,5,6,7,8,9,0,3] "1234-5678-903") $ eval3P cc11 ol "12345678903" , expect3 (Left $ XTFalse [1,2,3,4,5,6,7,8,9,0,1] "") $ eval3P cc11 oz "12345678901" -- , expect3 (Right $ unsafeRefined3 True ["T","r","ue","Tr","ue"]) $ eval3P (Proxy @'(Id, Id, Do '[ShowP Id, Dup, Sapa, SplitAts '[1,1,2,2]], Bool)) True @@ -200,7 +200,7 @@ type HexLtR3 = Refined3 (ReadBase Int 16 Id) (Id < 500) (ShowBase 16 Id) String type IntLtR3 = Refined3 (ReadP Int Id) (Id < 10) (ShowP Id) String -type Tst1 = '(ReadP Int Id, Between 1 7, PrintF "someval val=%03d" Id, String) +type Tst1 = '(ReadP Int Id, Between 1 7 Id, PrintF "someval val=%03d" Id, String) yy1, yy2, yy3, yy4 :: RefinedT Identity (MakeR3 Tst1) @@ -219,7 +219,7 @@ -- better to use Guard for op boolean check cos we get better errormessages -- 1. packaged up as a promoted tuple -type Tst3 = '(Map (ReadP Int Id) (Resplit "\\." Id), (Len == 4) && All (Between 0 255) Id, ConcatMap (PrintF "%03d" Id) Id, String) +type Tst3 = '(Map (ReadP Int Id) (Resplit "\\." Id), (Len == 4) && All (Between 0 255 Id) Id, ConcatMap (PrintF "%03d" Id) Id, String) www1, www2 :: String -> Either Msg3 (MakeR3 Tst3) www1 = prtEval3P (mkProxy3 @Tst3) o2 @@ -230,7 +230,7 @@ -- 2. packaged as a proxy tst3 :: Proxy '(Map (ReadP Int Id) (Resplit "\\." Id) - ,(Len == 4) && All (Between 0 255) Id + ,(Len == 4) && All (Between 0 255 Id) Id ,ConcatMap (PrintF "%03d" Id) Id ,String) tst3 = mkProxy3 @@ -239,14 +239,14 @@ -- 3. direct ww3 :: String -> Either Msg3 (Refined3 (Map (ReadP Int Id) (Resplit "\\." Id)) - ((Len == 4) && All (Between 0 255) Id) + ((Len == 4) && All (Between 0 255 Id) Id) (ConcatMap (PrintF "%03d" Id) Id) String) ww3 = prtEval3 o2 {- ww3 = prtEval3 @(Map (ReadP Int Id) (Resplit "\\." Id)) - @((Len == 4) && All (Between 0 255)) + @((Len == 4) && All (Between 0 255 Id)) @(ConcatMap (PrintF "%03d" Id) Id) o2 -} @@ -260,7 +260,7 @@ type Ip9 = '( Map (ReadP Int Id) (Resplit "\\." Id) -- split String on "." then convert to [Int] - ,Len == 4 && All (Between 0 255) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255 + ,Len == 4 && All (Between 0 255 Id) Id -- process [Int] and make sure length==4 and each octet is between 0 and 255 ,PrintL 4 "%03d.%03d.%03d.%03d" Id -- printf [Int] ,String -- input type is string which is also the output type ) @@ -276,13 +276,13 @@ -- prtRefinedT tst1a tst1a :: Monad m => POpts -> RefinedT m ((Int,String),(Int,String)) -tst1a opts = withRefined3T @(ReadBase Int 16 Id) @(Between 100 200) @(ShowBase 16 Id) @String opts "a3" +tst1a opts = withRefined3T @(ReadBase Int 16 Id) @(Between 100 200 Id) @(ShowBase 16 Id) @String opts "a3" $ \r1 -> withRefined3T @(ReadP Int Id) @'True @(ShowP Id) @String opts "12" $ \r2 -> return ((r3In r1, r3Out r1), (r3In r2, r3Out r2)) -- prtRefinedTIO tst2a tst2a :: MonadIO m => POpts -> RefinedT m ((Int,String),(Int,String)) -tst2a opts = withRefined3TIO @(ReadBase Int 16 Id) @(Stderr "start" |> Between 100 200 >| Stdout "end") @(ShowBase 16 Id) @String opts "a3" +tst2a opts = withRefined3TIO @(ReadBase Int 16 Id) @(Stderr "start" |> Between 100 200 Id >| Stdout "end") @(ShowBase 16 Id) @String opts "a3" $ \r1 -> withRefined3TIO @(ReadP Int Id) @'True @(ShowP Id) @String opts "12" $ \r2 -> return ((r3In r1, r3Out r1), (r3In r2, r3Out r2))
test/TestSpec.hs view
@@ -6,9 +6,12 @@ import qualified TestRefined3 import Data.Functor import Test.Tasty +import System.IO main :: IO () -main = +main = do + hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering defaultMain $ testGroup "alltests" [ TestJson.suite , TestPredicate.suite