{-# 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 #-}
module Predicate.Examples.Common (
DateNip
, DateFmts
, DateTimeFmts
, DateTimeNip
, Dtip
, Dtfmt
, DdmmyyyyRE
, Ddmmyyyyop
, Ddmmyyyyop'
, JsonMicrosoftDateTime
, Hmsip
, Hmsop
, Hmsop'
, Hmsfmt
, HmsRE
, Ccip
, Ccop
, Ccfmt
, Luhnip
, Luhnop
, Luhn'
, Luhnop'
, Luhn''
, Ssnip
, Ssnop
, Ssnfmt
, Ip4ip
, Ip4ip'
, Ip4op
, Ip4op'
, Ip4fmt
, OctetRE
, Ip4RE
, Ip4StrictRE
, Ip6ip
, Ip6op
, Ip6fmt
, Isbn10ip
, Isbn10op
, Isbn10fmt
, Isbn13ip
, Isbn13op
, Isbn13fmt
) where
import Predicate.Prelude
import GHC.TypeLits (Nat)
import Data.Time
type Ccip = Map (ReadP Int Id) (Ones (Remove "-" Id))
type Ccop (n :: Nat) = Guard (PrintT "expected %d digits but found %d" '(n,Len)) (Len == n) >> Luhn Id
type Ccfmt (ns :: [Nat]) = ConcatMap (ShowP Id) Id >> SplitAts ns Id >> Concat (Intercalate '["-"] Id)
type Luhnip = Map (ReadP Int Id) (Ones Id)
type Luhnop (n :: Nat) = Msg "incorrect number of digits:" (Len == n) && Luhn Id
type Dtip t = ParseTimeP t "%F %T" Id
type Dtfmt = FormatTimeP "%F %T" Id
type Ssnip = Map (ReadP Int Id) (Rescan "^(\\d{3})-(\\d{2})-(\\d{4})$" Id >> Snd (OneP Id))
type Ssnop = BoolsQuick (PrintT "number for group %d invalid: found %d" Id)
'[Between 1 899 Id && Id /= 666, Between 1 99 Id, Between 1 9999 Id]
type Ssnfmt = PrintL 3 "%03d-%02d-%04d" Id
type Hmsip = Map (ReadP Int Id) (Resplit ":" Id)
type Hmsop = GuardsDetail "%s invalid: found %d" '[ '("hours", Between 0 23 Id),'("minutes",Between 0 59 Id),'("seconds",Between 0 59 Id)]
type Hmsop' = Bools '[ '("hours", Between 0 23 Id), '("minutes",Between 0 59 Id), '("seconds",Between 0 59 Id) ]
type Hmsfmt = PrintL 3 "%02d:%02d:%02d" Id
type HmsRE = "^([0-1][0-9]|2[0-3]):([0-5][0-9]):([0-5][0-9])$"
type Ip4RE = "^(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})\\.(\\d{1,3})$"
type Ip4ip = Map (ReadP Int Id) (Resplit "\\." Id)
type Ip4ip' = Map (ReadP Int Id) (Rescan Ip4RE Id >> Snd (OneP Id))
type Ip4op' = BoolsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255 Id)
type Ip4op = GuardsN (PrintT "octet %d out of range 0-255 found %d" Id) 4 (Between 0 255 Id)
type Ip4fmt = PrintL 4 "%03d.%03d.%03d.%03d" Id
type OctetRE = "(25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[1-9][0-9]|[0-9])"
type Ip4StrictRE = "^" <%> IntersperseT "\\." (RepeatT 4 OctetRE) <%> "$"
type Ip6ip = Resplit ":" Id
>> Map (If (Id == "") "0" Id) Id
>> Map (ReadBase Int 16 Id) Id
>> PadL 8 0 Id
type Ip6op = Msg "count is bad:" (Len == 8)
&& Msg "out of bounds:" (All (Between 0 65535 Id) Id)
type Ip6fmt = PrintL 8 "%04x:%04x:%04x:%04x:%04x:%04x:%04x:%04x" Id
type Isbn10ip = Resplit "-" Id
>> Concat Id
>> 'Just Unsnoc
>> Map (ReadP Int (Singleton Id)) Id *** If (Singleton Id ==~ "X") 10 (ReadP Int (Singleton Id))
type Isbn10op = GuardSimple (All (0 <..> 9) (Fst Id) && Between 0 10 (Snd Id))
>> ZipWith (Fst Id * Snd Id) (1...10 >> Reverse) (Fst Id +: Snd Id)
>> Sum
>> Guard "mod 0 oops" (Id `Mod` 11 == 0)
>> 'True
type Isbn10fmt = ConcatMap (ShowP Id) Id *** If (Id == 10) "X" (ShowP Id)
>> Fst Id <> "-" <> Snd Id
type Isbn13ip = Resplit "-" Id
>> Concat Id
>> Map (ReadP Int (Singleton Id)) Id
type Isbn13op = ZipWith (Fst Id * Snd Id) (Cycle 13 [1,3] >> Reverse) Id
>> Sum
>> '(Id,Id `Mod` 10)
>> Guard (PrintT "sum=%d mod 10=%d" Id) (Snd Id == 0)
>> 'True
type Isbn13fmt = 'Just Unsnoc >> ConcatMap (ShowP Id) (Fst Id) <> "-" <> ShowP (Snd Id)
type DateFmts = '["%Y-%m-%d", "%m/%d/%y", "%B %d %Y"]
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"]
type DateTimeNip = ParseTimes UTCTime DateTimeFmts Id
type DdmmyyyyRE = "^(\\d{2})-(\\d{2})-(\\d{4})$"
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 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
,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)
,Do
'[Ones Id
,Map (ReadP Int Id) Id
,Reverse
,Zip (Cycle n [1,2]) Id
,Map (Fst Id * Snd Id >> If (Id >= 10) (Id - 9) Id) Id
,Sum
]
,Guard (PrintT "expected %d mod 10 = 0 but found %d" '(Id, Id `Mod` 10)) (Mod Id 10 == 0)
])
type JsonMicrosoftDateTime =
Do '[ Rescan "^Date\\((\\d+)(\\d{3}[+-]\\d{4})\\)" Id
, Head Id
, Snd Id
, Id !! 0 <> "." <> Id !! 1
, ParseTimeP ZonedTime "%s%Q%z" Id
]