{-# OPTIONS -Wall #-} {-# OPTIONS -Wcompat #-} {-# OPTIONS -Wincomplete-record-updates #-} {-# OPTIONS -Wincomplete-uni-patterns #-} {-# OPTIONS -Wredundant-constraints #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE NoStarIsType #-} {-# LANGUAGE TypeApplications #-} {- | Contains prepackaged 4-tuples to use with 'Refined3' -} module Predicate.Refined3Helper ( -- ** date time checkers datetime1 , DateTime1 , hms , Hms , HmsRE , Hmsip , Hmsop , Hmsfmt , DateFmts , DateN , DateTimeFmts , DateTimeN , daten , datetimen -- ** credit cards , ccn , cc11 , Ccn , CC11 , LuhnR , LuhnT -- ** ssn , ssn , Ssn -- ** ipv4 , ip , Ip , OctetRE , Ip4StrictRE -- ** base n , basen , base16 , basen' , BaseN , BaseN' , BaseIJ , BaseIJ' -- ** read / show , readshow , ReadShow , ReadShowR , readshow' , ReadShow' , ReadShowR' -- ** between , between , BetweenR , BetweenN -- ** miscellaneous , ok , Ok , OkR , oknot , OkNot , OkNotR ) where import Predicate.Refined3 import Predicate.Core import Predicate.Prelude import Predicate.Util import Data.Proxy import GHC.TypeLits (AppendSymbol,Nat) import Data.Kind (Type) import Data.Time -- $setup -- >>> :set -XDataKinds -- >>> :set -XTypeApplications -- >>> :set -XTypeOperators -- >>> :set -XNoStarIsType -- | credit card with luhn algorithm -- -- >>> prtEval3P cc11 ol "1234-5678-901" -- Left Step 2. False Boolean Check(op) | FalseP -- -- >>> prtEval3P cc11 ol "1234-5678-903" -- Right (Refined3 {r3In = [1,2,3,4,5,6,7,8,9,0,3], r3Out = "1234-5678-903"}) -- -- >>> pl @(Ccip >> Ccop 11) "79927398713" -- True -- TrueT -- -- >>> pl @(Ccip >> Ccop 10) "79927398713" -- Error expected 10 digits but found 11 -- FailT "expected 10 digits but found 11" -- type Ccip = Map (ReadP Int) (Ones (Remove "-" Id)) type Ccop (n :: Nat) = Guard ('(n,Len) >> Printf2 "expected %d digits but found %d") (Len >> Same n) >> Luhn Id type Ccfmt (ns :: [Nat]) = ConcatMap (ShowP Id) Id >> SplitAts ns Id >> Concat (Intercalate '["-"] Id) type Ccn (ns :: [Nat]) = '(Ccip, Ccop (SumT ns), Ccfmt ns, String) type CC11 = Ccn '[4,4,3] -- not great for the general case: but specific case is easier ccn :: Proxy (Ccn ns) ccn = mkProxy3 cc11 :: Proxy (Ccn '[4,4,3]) -- or Proxy CC11 cc11 = mkProxy3P -- | read in a valid datetime -- -- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 02:57:04" -- Right (Refined3 {r3In = 2018-09-14 02:57:04, r3Out = "2018-09-14 02:57:04"}) -- -- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 99:98:97" -- Left Step 2. Failed Boolean Check(op) | hours invalid: found 99 -- -- >>> prtEval3P (datetime1 @LocalTime) ol "2018-09-14 23:01:97" -- Left Step 2. Failed Boolean Check(op) | seconds invalid: found 97 -- -- >>> prtEval3P (Proxy @(DateTime1 UTCTime)) ol "2018-09-14 99:98:97" -- Right (Refined3 {r3In = 2018-09-18 04:39:37 UTC, r3Out = "2018-09-18 04:39:37"}) -- datetime1 :: Proxy (DateTime1 t) datetime1 = mkProxy3P type DateTime1 (t :: Type) = '(Dtip t, Dtop, Dtfmt, String) type Dtip t = ParseTimeP t "%F %T" Id -- extra check to validate the time as parseTime doesnt validate the time component -- ZonedTime LocalTime and TimeOfDay don't do validation and allow invalid stuff through : eg 99:98:97 is valid -- UTCTime will do the same but any overages get tacked on to the day and time as necessary: makes the time valid! 99:98:97 becomes 04:39:37 -- 2018-09-14 99:00:96 becomes 2018-09-18 03:01:36 {- type Dtop' = Map (ReadP Int) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id) >> Guards '[ '(Printf2 "guard %d invalid hours %d", Between 0 23) , '(Printf2 "guard %d invalid minutes %d", Between 0 59) , '(Printf2 "guard %d invalid seconds %d", Between 0 59) ] >> 'True -} type Dtop = Map (ReadP Int) (FormatTimeP "%H %M %S" Id >> Resplit "\\s+" Id) >> GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23) , '("minutes",Between 0 59) , '("seconds",Between 0 59) ] >> 'True type Dtfmt = FormatTimeP "%F %T" Id ssn :: Proxy Ssn ssn = mkProxy3 -- | read in an ssn -- -- >>> prtEval3P ssn ol "134-01-2211" -- Right (Refined3 {r3In = [134,1,2211], r3Out = "134-01-2211"}) -- -- >>> prtEval3P ssn ol "666-01-2211" -- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666 -- -- >>> prtEval3P ssn ol "666-01-2211" -- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666 -- -- >>> prtEval3P ssn ol "667-00-2211" -- Left Step 2. Failed Boolean Check(op) | number for group 2 invalid: found 0 -- -- >>> prtEval3P ssn ol "666-01-2211" -- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 666 -- -- >>> prtEval3P ssn ol "991-22-9999" -- Left Step 2. Failed Boolean Check(op) | number for group 1 invalid: found 991 -- type Ssn = '(Ssnip, Ssnop, Ssnfmt, String) type Ssnip = Map (ReadP Int) (Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> Snd OneP) type Ssnop = GuardsQuick (Printf2 "number for group %d invalid: found %d") '[Between 1 899 && Id /= 666, Between 1 99, Between 1 9999] >> 'True {- type Ssnop' = GuardsDetail "%s invalid: found %d" '[ '("first", Between 1 899 && Id /= 666) , '("second", Between 1 99) , '("third" , Between 1 9999) ] >> 'True -} type Ssnfmt = Printfnt 3 "%03d-%02d-%04d" -- | read in a time and validate it -- -- >>> prtEval3P hms ol "23:13:59" -- Right (Refined3 {r3In = [23,13,59], r3Out = "23:13:59"}) -- -- >>> prtEval3P hms ol "23:13:60" -- Left Step 2. Failed Boolean Check(op) | seconds invalid: found 60 -- -- >>> prtEval3P hms ol "26:13:59" -- Left Step 2. Failed Boolean Check(op) | hours invalid: found 26 -- hms :: Proxy Hms hms = mkProxy3 type Hms = '(Hmsip, Hmsop >> 'True, Hmsfmt, String) type Hmsip = Map (ReadP Int) (Resplit ":" Id) type Hmsop = GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23),'("minutes",Between 0 59),'("seconds",Between 0 59)] {- type Hmsop = Guard (Printf "expected len 3 but found %d" Len) (Length Id == 3) >> Guards '[ '(Printf2 "guard(%d) %d hours is out of range", Between 0 23) , '(Printf2 "guard(%d) %d mins is out of range", Between 0 59) , '(Printf2 "guard(%d) %d secs is out of range", Between 0 59)] -} type Hmsfmt = Printfnt 3 "%02d:%02d:%02d" -- | read in an ipv4 address and validate it -- -- >>> prtEval3P ip ol "001.223.14.1" -- Right (Refined3 {r3In = [1,223,14,1], r3Out = "001.223.014.001"}) -- -- >>> prtEval3P ip ol "001.223.14.999" -- Left Step 2. Failed Boolean Check(op) | guard(4) octet out of range 0-255 found 999 -- -- >>> prtEval3P ip ol "001.223.14.999.1" -- Left Step 1. Initial Conversion(ip) Failed | Regex no results -- -- >>> prtEval3P ip ol "001.257.14.1" -- Left Step 2. Failed Boolean Check(op) | guard(2) octet out of range 0-255 found 257 -- type Ip = '(Ipip, Ipop, Ipfmt, String) ip :: Proxy Ip ip = mkProxy3 type Ipip = Map (ReadP Int) (Rescan "^(\\d{1,3}).(\\d{1,3}).(\\d{1,3}).(\\d{1,3})$" Id >> OneP >> Snd Id) -- RepeatT is a type family so it expands everything! replace RepeatT with a type class type Ipop = GuardsN (Printf2 "guard(%d) octet out of range 0-255 found %d") 4 (Between 0 255) >> 'True type Ipfmt = Printfnt 4 "%03d.%03d.%03d.%03d" 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' 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` "$" -- 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"] type DateN = '(ParseTimes Day DateFmts Id, 'True, FormatTimeP "%Y-%m-%d" Id, String) 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"] type DateTimeN = '(ParseTimes UTCTime DateTimeFmts Id, 'True, FormatTimeP "%Y-%m-%d %H:%M:%S" Id, String) -- | convert a string from a given base \'i\' and store it internally as an base 10 integer -- -- >>> prtEval3P base16 ol "00fe" -- Right (Refined3 {r3In = 254, r3Out = "fe"}) -- -- >>> prtEval3P (basen' @16 @(Between 100 400)) ol "00fe" -- Right (Refined3 {r3In = 254, r3Out = "fe"}) -- -- >>> prtEval3P (basen' @16 @(GuardSimple (Id < 400) >> 'True)) ol "f0fe" -- Left Step 2. Failed Boolean Check(op) | 61694 < 400 -- type BaseN (n :: Nat) = BaseN' n 'True type BaseN' (n :: Nat) p = '(ReadBase Int n, p, ShowBase n, String) base16 :: Proxy (BaseN 16) base16 = basen @16 -- replace with BetweenT 2 36 n --basen :: forall n . (KnownNat n, (n GN.<=? 36) ~ 'True, (2 GN.<=? n) ~ 'True) => Proxy (BaseN n) --basen = mkProxy3 basen :: Proxy (BaseN n) basen = mkProxy3 basen' :: Proxy (BaseN' n p) basen' = mkProxy3 {- basen' :: forall n p . (P p Int , PP p Int ~ Bool , KnownNat n , (n GN.<=? 36) ~ 'True , (2 GN.<=? n) ~ 'True ) => Proxy (BaseN' n p) basen' = mkProxy3 -} daten :: Proxy DateN daten = mkProxy3 datetimen :: Proxy DateTimeN datetimen = mkProxy3 -- | ensures that two numbers are in a given range (emulates 'Refined.Refined') -- -- >>> prtEval3P (between @10 @16) ol 14 -- Right (Refined3 {r3In = 14, r3Out = 14}) -- -- >>> prtEval3P (between @10 @16) ol 17 -- Left Step 2. False Boolean Check(op) | FalseP -- -- >>> prtEval3P (between @10 @16) o0 17 -- Left Step 2. False Boolean Check(op) | FalseP -- <BLANKLINE> -- *** Step 1. Success Initial Conversion(ip) [17] *** -- <BLANKLINE> -- P Id 17 -- <BLANKLINE> -- *** Step 2. False Boolean Check(op) *** -- <BLANKLINE> -- False True && False -- | -- +- True 17 >= 10 -- | | -- | +- P I -- | | -- | `- P '10 -- | -- `- False 17 <= 16 -- | -- +- P I -- | -- `- P '16 -- <BLANKLINE> -- 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 LuhnR (n :: Nat) = MakeR3 (LuhnT n) -- | Luhn check -- -- >>> prtEval3P (Proxy @(LuhnT 4)) ol "1230" -- Right (Refined3 {r3In = [1,2,3,0], r3Out = "1230"}) -- -- >>> prtEval3P (Proxy @(LuhnT 4)) ol "1234" -- Left Step 2. Failed Boolean Check(op) | Luhn map=[4,6,2,2] sum=14 ret=4 | [1,2,3,4] -- | uses builtin 'Luhn' type LuhnT (n :: Nat) = '(Map (ReadP Int) (Ones Id) , Guard (Printfn "incorrect number of digits found %d but expected %d in [%s]" (TupleI '[Len, W n, ShowP Id])) (Len >> Same n) >> GuardSimple (Luhn Id) >> 'True , ConcatMap (ShowP Id) Id , String) -- | noop true type Ok (t :: Type) = '(Id, 'True, Id, t) type OkR (t :: Type) = MakeR3 (Ok t) ok :: Proxy (Ok t) ok = mkProxy3 -- | noop false type OkNot (t :: Type) = '(Id, 'False, Id, t) type OkNotR (t :: Type) = MakeR3 (OkNot t) oknot :: Proxy (OkNot t) oknot = mkProxy3 -- | convert a string from a given base \'i\' and store it internally as a base \'j\' string -- -- >>> prtEval3P (Proxy @(BaseIJ 16 2)) ol "fe" -- Right (Refined3 {r3In = "11111110", r3Out = "fe"}) -- -- >>> prtEval3P (Proxy @(BaseIJ 16 2)) ol "fge" -- Left Step 1. Initial Conversion(ip) Failed | invalid base 16 -- -- >>> prtEval3P (Proxy @(BaseIJ' 16 2 (GuardSimple (ReadBase Int 2 < 1000) >> 'True))) ol "ffe" -- Left Step 2. Failed Boolean Check(op) | 4094 < 1000 -- type BaseIJ (i :: Nat) (j :: Nat) = BaseIJ' i j 'True type BaseIJ' (i :: Nat) (j :: Nat) p = '(ReadBase Int i >> ShowBase j, p, ReadBase Int j >> ShowBase i, String) -- | take any valid Read/Show instance and turn it into a valid 'Refined3' -- -- >>> :m + Data.Ratio -- >>> prtEval3P (readshow @Rational) ol "13 % 3" -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"}) -- -- >>> prtEval3P (readshow @Rational) ol "13x % 3" -- Left Step 1. Initial Conversion(ip) Failed | ReadP Ratio Integer (13x % 3) failed -- -- >>> prtEval3P (readshow' @Rational @(Between (3 % 1) (5 % 1))) ol "13 % 3" -- Right (Refined3 {r3In = 13 % 3, r3Out = "13 % 3"}) -- -- >>> prtEval3P (Proxy @(ReadShow' Rational (Between (11 %- 2) (3 %- 1)))) ol "-13 % 3" -- Right (Refined3 {r3In = (-13) % 3, r3Out = "(-13) % 3"}) -- -- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (15 % 1)))) ol "13 % 3" -- Left Step 2. False Boolean Check(op) | FalseP -- -- >>> prtEval3P (Proxy @(ReadShow' Rational (Guard (Printf "invalid=%3.2f" (FromRational Double Id)) (Id > (15 % 1)) >> 'True))) ol "13 % 3" -- Left Step 2. Failed Boolean Check(op) | invalid=4.33 -- -- >>> prtEval3P (Proxy @(ReadShow' Rational (Id > (11 % 1)))) ol "13 % 3" -- Left Step 2. False Boolean Check(op) | FalseP -- -- >>> let tmString = "2018-10-19 14:53:11.5121359 UTC" -- >>> let tm = read tmString :: UTCTime -- >>> prtEval3P (readshow @UTCTime) ol tmString -- Right (Refined3 {r3In = 2018-10-19 14:53:11.5121359 UTC, r3Out = "2018-10-19 14:53:11.5121359 UTC"}) -- -- >>> :m + Data.Aeson -- >>> prtEval3P (readshow @Value) ol "String \"jsonstring\"" -- Right (Refined3 {r3In = String "jsonstring", r3Out = "String \"jsonstring\""}) -- -- >>> prtEval3P (readshow @Value) ol "Number 123.4" -- Right (Refined3 {r3In = Number 123.4, r3Out = "Number 123.4"}) -- type ReadShow (t :: Type) = '(ReadP t, 'True, ShowP Id, String) type ReadShowR (t :: Type) = MakeR3 (ReadShow t) type ReadShow' (t :: Type) p = '(ReadP t, p, ShowP Id, String) type ReadShowR' (t :: Type) p = MakeR3 (ReadShow' t p) readshow :: Proxy (ReadShow t) readshow = mkProxy3 readshow' :: Proxy (ReadShow' t p) readshow' = mkProxy3