{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | promoted date time functions

module Predicate.Data.DateTime (

  -- ** format

    FormatTimeP
  , FormatTimeP'

  -- ** constructors

  , ParseTimeP
  , ParseTimeP'
  , ParseTimes
  , ParseTimes'
  , MkDay
  , MkDay'
  , MkDayExtra
  , MkDayExtra'
  , MkTime
  , MkTime'
  , PosixToUTCTime
  , DiffUTCTime
  , DiffLocalTime

 -- ** destructors

  , UnMkDay
  , ToWeekDate
  , ToWeekYear
  , ToDay
  , ToTime
  , UnMkTime
  , UTCTimeToPosix
  , LocalTimeToUTC
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Control.Lens
import Data.Typeable (Typeable, Proxy(Proxy))
import Data.Kind (Type)
import Data.Maybe (catMaybes)
import Data.Time
import Data.Time.Calendar.WeekDate (toWeekDate)
import qualified Data.Time.Clock.System as CP
import qualified Data.Time.Clock.POSIX as P
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import qualified Data.Text as T

-- >>> import Predicate

-- >>> import Safe (readNote)


-- | type level expression representing a formatted time

--   similar to 'Data.Time.formatTime' using a type level 'GHC.TypeLits.Symbol' to get the formatting string

--

-- >>> pz @(FormatTimeP' Fst Snd) ("the date is %d/%m/%Y", readNote @Day "invalid day" "2019-05-24")

-- Val "the date is 24/05/2019"

--

data FormatTimeP' p q deriving Int -> FormatTimeP' p q -> ShowS
[FormatTimeP' p q] -> ShowS
FormatTimeP' p q -> String
(Int -> FormatTimeP' p q -> ShowS)
-> (FormatTimeP' p q -> String)
-> ([FormatTimeP' p q] -> ShowS)
-> Show (FormatTimeP' p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> FormatTimeP' p q -> ShowS
forall k (p :: k) k (q :: k). [FormatTimeP' p q] -> ShowS
forall k (p :: k) k (q :: k). FormatTimeP' p q -> String
showList :: [FormatTimeP' p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [FormatTimeP' p q] -> ShowS
show :: FormatTimeP' p q -> String
$cshow :: forall k (p :: k) k (q :: k). FormatTimeP' p q -> String
showsPrec :: Int -> FormatTimeP' p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> FormatTimeP' p q -> ShowS
Show

instance ( PP p x ~ String
         , FormatTime (PP q x)
         , P p x
         , Show (PP q x)
         , P q x
         ) => P (FormatTimeP' p q) x where
  type PP (FormatTimeP' p q) x = String
  eval :: proxy (FormatTimeP' p q)
-> POpts -> x -> m (TT (PP (FormatTimeP' p q) x))
eval proxy (FormatTimeP' p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"FormatTimeP"
    Either (TT String) (String, PP q x, TT String, TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT String) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Either (TT String) (String, PP q x, TT String, TT (PP q x))
lr of
      Left TT String
e -> TT String
e
      Right (String
p,PP q x
q,TT String
pp,TT (PP q x)
qq) ->
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
            d :: String
d = TimeLocale -> String -> PP q x -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
p PP q x
q
        in POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
d) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> PP q x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " PP q x
q) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]

-- | type level expression representing a formatted time

--

-- >>> pz @(FormatTimeP "%F %T") (readNote @LocalTime "invalid localtime" "2019-05-24 05:19:59")

-- Val "2019-05-24 05:19:59"

--

-- >>> pl @(FormatTimeP "%Y-%m-%d") (readNote @Day "invalid day" "2019-08-17")

-- Present "2019-08-17" (FormatTimeP (%Y-%m-%d) 2019-08-17 | 2019-08-17)

-- Val "2019-08-17"

--

data FormatTimeP p deriving Int -> FormatTimeP p -> ShowS
[FormatTimeP p] -> ShowS
FormatTimeP p -> String
(Int -> FormatTimeP p -> ShowS)
-> (FormatTimeP p -> String)
-> ([FormatTimeP p] -> ShowS)
-> Show (FormatTimeP p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FormatTimeP p -> ShowS
forall k (p :: k). [FormatTimeP p] -> ShowS
forall k (p :: k). FormatTimeP p -> String
showList :: [FormatTimeP p] -> ShowS
$cshowList :: forall k (p :: k). [FormatTimeP p] -> ShowS
show :: FormatTimeP p -> String
$cshow :: forall k (p :: k). FormatTimeP p -> String
showsPrec :: Int -> FormatTimeP p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FormatTimeP p -> ShowS
Show
type FormatTimePT p = FormatTimeP' p Id

instance P (FormatTimePT p) x => P (FormatTimeP p) x where
  type PP (FormatTimeP p) x = PP (FormatTimePT p) x
  eval :: proxy (FormatTimeP p)
-> POpts -> x -> m (TT (PP (FormatTimeP p) x))
eval proxy (FormatTimeP p)
_ = Proxy (FormatTimePT p)
-> POpts -> x -> m (TT (PP (FormatTimePT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FormatTimePT p)
forall k (t :: k). Proxy t
Proxy @(FormatTimePT p))



-- | similar to 'Data.Time.parseTimeM' where @t@ is the 'Data.Time.ParseTime' type, @p@ is the datetime format and @q@ points to the content to parse

-- keeping @q@ as we might want to extract from a tuple

data ParseTimeP' t p q deriving Int -> ParseTimeP' t p q -> ShowS
[ParseTimeP' t p q] -> ShowS
ParseTimeP' t p q -> String
(Int -> ParseTimeP' t p q -> ShowS)
-> (ParseTimeP' t p q -> String)
-> ([ParseTimeP' t p q] -> ShowS)
-> Show (ParseTimeP' t p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k) k (q :: k).
Int -> ParseTimeP' t p q -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
[ParseTimeP' t p q] -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
ParseTimeP' t p q -> String
showList :: [ParseTimeP' t p q] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k) k (q :: k).
[ParseTimeP' t p q] -> ShowS
show :: ParseTimeP' t p q -> String
$cshow :: forall k (t :: k) k (p :: k) k (q :: k).
ParseTimeP' t p q -> String
showsPrec :: Int -> ParseTimeP' t p q -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k) k (q :: k).
Int -> ParseTimeP' t p q -> ShowS
Show

instance ( ParseTime (PP t a)
         , Typeable (PP t a)
         , Show (PP t a)
         , P p a
         , P q a
         , PP p a ~ String
         , PP q a ~ String
         ) => P (ParseTimeP' t p q) a where
  type PP (ParseTimeP' t p q) a = PP t a
  eval :: proxy (ParseTimeP' t p q)
-> POpts -> a -> m (TT (PP (ParseTimeP' t p q) a))
eval proxy (ParseTimeP' t p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"ParseTimeP " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t a) => String
forall t. Typeable t => String
showT @(PP t a)
    Either (TT (PP t a)) (String, String, TT String, TT String)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP t a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP t a)) (String, String, TT String, TT String)
lr of
      Left TT (PP t a)
e -> TT (PP t a)
e
      Right (String
p,String
q,TT String
pp,TT String
qq) ->
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
            hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
qq]
        in case Bool -> TimeLocale -> String -> String -> Maybe (PP t a)
forall (m :: Type -> Type) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM @Maybe @(PP t a) Bool
True TimeLocale
defaultTimeLocale String
p String
q of
             Just PP t a
d -> POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
d) (POpts -> String -> PP t a -> String -> ShowS
forall a1. Show a1 => POpts -> String -> a1 -> String -> ShowS
lit3 POpts
opts String
msg1 PP t a
d String
"fmt=" String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " String
q) [Tree PE]
hhs
             Maybe (PP t a)
Nothing -> POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t a)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" failed to parse")) String
"" [Tree PE]
hhs
-- | similar to 'Date.Time.parseTimeM'

--

-- >>> pz @(ParseTimeP LocalTime "%F %T") "2019-05-24 05:19:59"

-- Val 2019-05-24 05:19:59

--

-- >>> pz @("2019-05-24 05:19:59" >> ParseTimeP LocalTime "%F %T") (Right "never used")

-- Val 2019-05-24 05:19:59

--

-- >>> pl @(ParseTimeP TimeOfDay "%H:%M%S") "14:04:61"

-- Error ParseTimeP TimeOfDay (%H:%M%S) failed to parse

-- Fail "ParseTimeP TimeOfDay (%H:%M%S) failed to parse"

--

-- >>> pl @(ParseTimeP UTCTime "%F %T") "1999-01-01 12:12:12"

-- Present 1999-01-01 12:12:12 UTC (ParseTimeP UTCTime (%F %T) 1999-01-01 12:12:12 UTC | fmt=%F %T | "1999-01-01 12:12:12")

-- Val 1999-01-01 12:12:12 UTC

--

-- >>> pz @(ParseTimeP ZonedTime "%s%Q%z")  "153014400.000+0530"

-- Val 1974-11-07 05:30:00 +0530

--

data ParseTimeP (t :: Type) p deriving Int -> ParseTimeP t p -> ShowS
[ParseTimeP t p] -> ShowS
ParseTimeP t p -> String
(Int -> ParseTimeP t p -> ShowS)
-> (ParseTimeP t p -> String)
-> ([ParseTimeP t p] -> ShowS)
-> Show (ParseTimeP t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> ParseTimeP t p -> ShowS
forall t k (p :: k). [ParseTimeP t p] -> ShowS
forall t k (p :: k). ParseTimeP t p -> String
showList :: [ParseTimeP t p] -> ShowS
$cshowList :: forall t k (p :: k). [ParseTimeP t p] -> ShowS
show :: ParseTimeP t p -> String
$cshow :: forall t k (p :: k). ParseTimeP t p -> String
showsPrec :: Int -> ParseTimeP t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> ParseTimeP t p -> ShowS
Show
type ParseTimePT (t :: Type) p = ParseTimeP' (Hole t) p Id

instance P (ParseTimePT t p) x => P (ParseTimeP t p) x where
  type PP (ParseTimeP t p) x = PP (ParseTimePT t p) x
  eval :: proxy (ParseTimeP t p)
-> POpts -> x -> m (TT (PP (ParseTimeP t p) x))
eval proxy (ParseTimeP t p)
_ = Proxy (ParseTimePT t p)
-> POpts -> x -> m (TT (PP (ParseTimePT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ParseTimePT t p)
forall k (t :: k). Proxy t
Proxy @(ParseTimePT t p))

-- | A convenience method to match against many different datetime formats to find the first match

data ParseTimes' t p q deriving Int -> ParseTimes' t p q -> ShowS
[ParseTimes' t p q] -> ShowS
ParseTimes' t p q -> String
(Int -> ParseTimes' t p q -> ShowS)
-> (ParseTimes' t p q -> String)
-> ([ParseTimes' t p q] -> ShowS)
-> Show (ParseTimes' t p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k) k (q :: k).
Int -> ParseTimes' t p q -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
[ParseTimes' t p q] -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
ParseTimes' t p q -> String
showList :: [ParseTimes' t p q] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k) k (q :: k).
[ParseTimes' t p q] -> ShowS
show :: ParseTimes' t p q -> String
$cshow :: forall k (t :: k) k (p :: k) k (q :: k).
ParseTimes' t p q -> String
showsPrec :: Int -> ParseTimes' t p q -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k) k (q :: k).
Int -> ParseTimes' t p q -> ShowS
Show

instance ( ParseTime (PP t a)
         , Typeable (PP t a)
         , Show (PP t a)
         , P p a
         , P q a
         , PP p a ~ [String]
         , PP q a ~ String
         ) => P (ParseTimes' t p q) a where
  type PP (ParseTimes' t p q) a = PP t a
  eval :: proxy (ParseTimes' t p q)
-> POpts -> a -> m (TT (PP (ParseTimes' t p q) a))
eval proxy (ParseTimes' t p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"ParseTimes " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t a) => String
forall t. Typeable t => String
showT @(PP t a)
    Either (TT (PP t a)) ([String], String, TT [String], TT String)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP t a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP t a)) ([String], String, TT [String], TT String)
lr of
      Left TT (PP t a)
e -> TT (PP t a)
e
      Right ([String]
p,String
q,TT [String]
pp,TT String
qq) ->
        let hhs :: [Tree PE]
hhs = [TT [String] -> Tree PE
forall a. TT a -> Tree PE
hh TT [String]
pp, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
qq]
            zs :: [Maybe (String, PP t a)]
zs = (String -> Maybe (String, PP t a))
-> [String] -> [Maybe (String, PP t a)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
d -> (String
d,) (PP t a -> (String, PP t a))
-> Maybe (PP t a) -> Maybe (String, PP t a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> TimeLocale -> String -> String -> Maybe (PP t a)
forall (m :: Type -> Type) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM @Maybe @(PP t a) Bool
True TimeLocale
defaultTimeLocale String
d String
q) [String]
p
        in case [Maybe (String, PP t a)] -> [(String, PP t a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, PP t a)]
zs of
             [] -> POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t a)
forall a. String -> Val a
Fail (String
"no match on (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")) String
msg0 [Tree PE]
hhs
             (String
d,PP t a
b):[(String, PP t a)]
_ -> POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
b) (POpts -> String -> PP t a -> String -> ShowS
forall a1. Show a1 => POpts -> String -> a1 -> String -> ShowS
lit3 POpts
opts String
msg0 PP t a
b String
"fmt=" String
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " String
q) [Tree PE]
hhs

-- | A convenience method to match against many different datetime formats to find the first match

--

-- >>> pz @(ParseTimes LocalTime '["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"] "03/11/19 01:22:33") ()

-- Val 2019-03-11 01:22:33

--

-- >>> pz @(ParseTimes LocalTime Fst Snd) (["%Y-%m-%d %H:%M:%S", "%m/%d/%y %H:%M:%S", "%B %d %Y %H:%M:%S", "%Y-%m-%dT%H:%M:%S"], "03/11/19 01:22:33")

-- Val 2019-03-11 01:22:33

--

-- >>> pl @(Map (ParseTimes Day '["%Y-%m-%d", "%m/%d/%y", "%b %d %Y"] Id)) ["2001-01-01", "Jan 24 2009", "03/29/0x7"]

-- Error no match on (03/29/0x7) (Map(i=2, a="03/29/0x7") excnt=1)

-- Fail "no match on (03/29/0x7)"

--

-- >>> pl @(Map (ParseTimes Day '["%Y-%m-%d", "%m/%d/%y", "%b %d %Y"] Id)) ["2001-01-01", "Jan 24 2009", "03/29/07"]

-- Present [2001-01-01,2009-01-24,2007-03-29] (Map [2001-01-01,2009-01-24,2007-03-29] | ["2001-01-01","Jan 24 2009","03/29/07"])

-- Val [2001-01-01,2009-01-24,2007-03-29]

--

data ParseTimes (t :: Type) p q deriving Int -> ParseTimes t p q -> ShowS
[ParseTimes t p q] -> ShowS
ParseTimes t p q -> String
(Int -> ParseTimes t p q -> ShowS)
-> (ParseTimes t p q -> String)
-> ([ParseTimes t p q] -> ShowS)
-> Show (ParseTimes t p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k) k (q :: k). Int -> ParseTimes t p q -> ShowS
forall t k (p :: k) k (q :: k). [ParseTimes t p q] -> ShowS
forall t k (p :: k) k (q :: k). ParseTimes t p q -> String
showList :: [ParseTimes t p q] -> ShowS
$cshowList :: forall t k (p :: k) k (q :: k). [ParseTimes t p q] -> ShowS
show :: ParseTimes t p q -> String
$cshow :: forall t k (p :: k) k (q :: k). ParseTimes t p q -> String
showsPrec :: Int -> ParseTimes t p q -> ShowS
$cshowsPrec :: forall t k (p :: k) k (q :: k). Int -> ParseTimes t p q -> ShowS
Show
type ParseTimesT (t :: Type) p q = ParseTimes' (Hole t) p q

instance P (ParseTimesT t p q) x => P (ParseTimes t p q) x where
  type PP (ParseTimes t p q) x = PP (ParseTimesT t p q) x
  eval :: proxy (ParseTimes t p q)
-> POpts -> x -> m (TT (PP (ParseTimes t p q) x))
eval proxy (ParseTimes t p q)
_ = Proxy (ParseTimesT t p q)
-> POpts -> x -> m (TT (PP (ParseTimesT t p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ParseTimesT t p q)
forall k (t :: k). Proxy t
Proxy @(ParseTimesT t p q))

-- | create a 'Day' from three int values passed in as year month and day

--

-- >>> pz @(MkDay' Fst Snd Thd) (2019,99,99999)

-- Val Nothing

--

data MkDay' p q r deriving Int -> MkDay' p q r -> ShowS
[MkDay' p q r] -> ShowS
MkDay' p q r -> String
(Int -> MkDay' p q r -> ShowS)
-> (MkDay' p q r -> String)
-> ([MkDay' p q r] -> ShowS)
-> Show (MkDay' p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkDay' p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [MkDay' p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). MkDay' p q r -> String
showList :: [MkDay' p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [MkDay' p q r] -> ShowS
show :: MkDay' p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). MkDay' p q r -> String
showsPrec :: Int -> MkDay' p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkDay' p q r -> ShowS
Show

instance ( P p x
         , P q x
         , P r x
         , PP p x ~ Int
         , PP q x ~ Int
         , PP r x ~ Int
        ) => P (MkDay' p q r) x where
  type PP (MkDay' p q r) x = Maybe Day
  eval :: proxy (MkDay' p q r) -> POpts -> x -> m (TT (PP (MkDay' p q r) x))
eval proxy (MkDay' p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"MkDay"
    Either (TT (Maybe Day)) (Int, Int, TT Int, TT Int)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (Maybe Day)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    case Either (TT (Maybe Day)) (Int, Int, TT Int, TT Int)
lr of
      Left TT (Maybe Day)
e -> TT (Maybe Day) -> m (TT (Maybe Day))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe Day)
e
      Right (Int
p,Int
q,TT Int
pp,TT Int
qq) -> do
        let hhs :: [Tree PE]
hhs = [TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
pp, TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
qq]
        TT Int
rr <- Proxy r -> POpts -> x -> m (TT (PP r x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
        TT (Maybe Day) -> m (TT (Maybe Day))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe Day) -> m (TT (Maybe Day)))
-> TT (Maybe Day) -> m (TT (Maybe Day))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Int
-> [Tree PE]
-> Either (TT (Maybe Day)) Int
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Int
rr [Tree PE]
hhs of
          Left TT (Maybe Day)
e -> TT (Maybe Day)
e
          Right Int
r ->
            let mday :: Maybe Day
mday = Integer -> Int -> Int -> Maybe Day
fromGregorianValid (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Int
q Int
r
            in POpts -> Val (Maybe Day) -> String -> [Tree PE] -> TT (Maybe Day)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe Day -> Val (Maybe Day)
forall a. a -> Val a
Val Maybe Day
mday) (POpts -> String -> Maybe Day -> String -> (Int, Int, Int) -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 Maybe Day
mday String
"(y,m,d)=" (Int
p,Int
q,Int
r)) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
rr])

-- | create a 'Day' from three int values passed in as year month and day

--

-- >>> pz @(MkDay '(1,2,3) >> 'Just Id) ()

-- Val 0001-02-03

--

-- >>> pz @('Just (MkDay '(1,2,3))) 1

-- Val 0001-02-03

--

-- >>> pz @(MkDay Id) (2019,12,30)

-- Val (Just 2019-12-30)

--

-- >>> pz @(MkDay Id) (1999,3,13)

-- Val (Just 1999-03-13)

--

data MkDay p deriving Int -> MkDay p -> ShowS
[MkDay p] -> ShowS
MkDay p -> String
(Int -> MkDay p -> ShowS)
-> (MkDay p -> String) -> ([MkDay p] -> ShowS) -> Show (MkDay p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> MkDay p -> ShowS
forall k (p :: k). [MkDay p] -> ShowS
forall k (p :: k). MkDay p -> String
showList :: [MkDay p] -> ShowS
$cshowList :: forall k (p :: k). [MkDay p] -> ShowS
show :: MkDay p -> String
$cshow :: forall k (p :: k). MkDay p -> String
showsPrec :: Int -> MkDay p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> MkDay p -> ShowS
Show
type MkDayT p = p >> MkDay' Fst Snd Thd

instance P (MkDayT p) x => P (MkDay p) x where
  type PP (MkDay p) x = PP (MkDayT p) x
  eval :: proxy (MkDay p) -> POpts -> x -> m (TT (PP (MkDay p) x))
eval proxy (MkDay p)
_ = Proxy (MkDayT p) -> POpts -> x -> m (TT (PP (MkDayT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MkDayT p)
forall k (t :: k). Proxy t
Proxy @(MkDayT p))

-- | uncreate a 'Day' returning year month and day

--

-- >>> pz @(UnMkDay Id) (readNote "invalid day" "2019-12-30")

-- Val (2019,12,30)

--

data UnMkDay p deriving Int -> UnMkDay p -> ShowS
[UnMkDay p] -> ShowS
UnMkDay p -> String
(Int -> UnMkDay p -> ShowS)
-> (UnMkDay p -> String)
-> ([UnMkDay p] -> ShowS)
-> Show (UnMkDay p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> UnMkDay p -> ShowS
forall k (p :: k). [UnMkDay p] -> ShowS
forall k (p :: k). UnMkDay p -> String
showList :: [UnMkDay p] -> ShowS
$cshowList :: forall k (p :: k). [UnMkDay p] -> ShowS
show :: UnMkDay p -> String
$cshow :: forall k (p :: k). UnMkDay p -> String
showsPrec :: Int -> UnMkDay p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> UnMkDay p -> ShowS
Show

instance ( PP p x ~ Day
         , P p x
         ) => P (UnMkDay p) x where
  type PP (UnMkDay p) x = (Int, Int, Int)
  eval :: proxy (UnMkDay p) -> POpts -> x -> m (TT (PP (UnMkDay p) x))
eval proxy (UnMkDay p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"UnMkDay"
    TT Day
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (Int, Int, Int) -> m (TT (Int, Int, Int))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Int, Int, Int) -> m (TT (Int, Int, Int)))
-> TT (Int, Int, Int) -> m (TT (Int, Int, Int))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Day
-> [Tree PE]
-> Either (TT (Int, Int, Int)) Day
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Day
pp [] of
      Left TT (Int, Int, Int)
e -> TT (Int, Int, Int)
e
      Right Day
p ->
        let (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
y, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
p
            b :: (Int, Int, Int)
b = (Int
y, Int
m, Int
d)
        in POpts
-> Val (Int, Int, Int) -> String -> [Tree PE] -> TT (Int, Int, Int)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((Int, Int, Int) -> Val (Int, Int, Int)
forall a. a -> Val a
Val (Int, Int, Int)
b) (POpts -> String -> (Int, Int, Int) -> Day -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 (Int, Int, Int)
b Day
p) [TT Day -> Tree PE
forall a. TT a -> Tree PE
hh TT Day
pp]


-- | create a 'Day', week number, and the day of the week from three numbers passed in as year month and day

--

-- >>> pz @(MkDayExtra' Fst Snd Thd) (2019,99,99999)

-- Val Nothing

--

data MkDayExtra' p q r deriving Int -> MkDayExtra' p q r -> ShowS
[MkDayExtra' p q r] -> ShowS
MkDayExtra' p q r -> String
(Int -> MkDayExtra' p q r -> ShowS)
-> (MkDayExtra' p q r -> String)
-> ([MkDayExtra' p q r] -> ShowS)
-> Show (MkDayExtra' p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkDayExtra' p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k).
[MkDayExtra' p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k).
MkDayExtra' p q r -> String
showList :: [MkDayExtra' p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k).
[MkDayExtra' p q r] -> ShowS
show :: MkDayExtra' p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k).
MkDayExtra' p q r -> String
showsPrec :: Int -> MkDayExtra' p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkDayExtra' p q r -> ShowS
Show

instance ( P p x
         , P q x
         , P r x
         , PP p x ~ Int
         , PP q x ~ Int
         , PP r x ~ Int
         ) => P (MkDayExtra' p q r) x where
  type PP (MkDayExtra' p q r) x = Maybe (Day, Int, Int)
  eval :: proxy (MkDayExtra' p q r)
-> POpts -> x -> m (TT (PP (MkDayExtra' p q r) x))
eval proxy (MkDayExtra' p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"MkDayExtra"
    Either (TT (Maybe (Day, Int, Int))) (Int, Int, TT Int, TT Int)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (Maybe (Day, Int, Int)))
        (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    case Either (TT (Maybe (Day, Int, Int))) (Int, Int, TT Int, TT Int)
lr of
      Left TT (Maybe (Day, Int, Int))
e -> TT (Maybe (Day, Int, Int)) -> m (TT (Maybe (Day, Int, Int)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe (Day, Int, Int))
e
      Right (Int
p,Int
q,TT Int
pp,TT Int
qq) -> do
        let hhs :: [Tree PE]
hhs = [TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
pp, TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
qq]
        TT Int
rr <- Proxy r -> POpts -> x -> m (TT (PP r x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
        TT (Maybe (Day, Int, Int)) -> m (TT (Maybe (Day, Int, Int)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe (Day, Int, Int)) -> m (TT (Maybe (Day, Int, Int))))
-> TT (Maybe (Day, Int, Int)) -> m (TT (Maybe (Day, Int, Int)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Int
-> [Tree PE]
-> Either (TT (Maybe (Day, Int, Int))) Int
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Int
rr [Tree PE]
hhs of
          Left TT (Maybe (Day, Int, Int))
e -> TT (Maybe (Day, Int, Int))
e
          Right Int
r ->
            let mday :: Maybe Day
mday = Integer -> Int -> Int -> Maybe Day
fromGregorianValid (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p) Int
q Int
r
                b :: Maybe (Day, Int, Int)
b = Maybe Day
mday Maybe Day -> (Day -> (Day, Int, Int)) -> Maybe (Day, Int, Int)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \Day
day ->
                      let (Integer
_, Int
week, Int
dow) = Day -> (Integer, Int, Int)
toWeekDate Day
day
                      in (Day
day, Int
week, Int
dow)
            in POpts
-> Val (Maybe (Day, Int, Int))
-> String
-> [Tree PE]
-> TT (Maybe (Day, Int, Int))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (Day, Int, Int) -> Val (Maybe (Day, Int, Int))
forall a. a -> Val a
Val Maybe (Day, Int, Int)
b) (POpts
-> String
-> Maybe (Day, Int, Int)
-> String
-> (Int, Int, Int)
-> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 Maybe (Day, Int, Int)
b String
"(y,m,d)=" (Int
p,Int
q,Int
r)) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
rr])

-- | create a 'Day', week number, and the day of the week from three numbers passed in as year month and day

--

-- >>> pz @(MkDayExtra '(1,2,3) >> 'Just Id >> Fst) ()

-- Val 0001-02-03

--

-- >>> pz @(L1 (Just (MkDayExtra '(1,2,3)))) 1

-- Val 0001-02-03

--

-- >>> pz @(MkDayExtra Id) (2019,12,30)

-- Val (Just (2019-12-30,1,1))

--

-- >>> pz @(MkDayExtra Id) (1999,3,13)

-- Val (Just (1999-03-13,10,6))

--

data MkDayExtra p deriving Int -> MkDayExtra p -> ShowS
[MkDayExtra p] -> ShowS
MkDayExtra p -> String
(Int -> MkDayExtra p -> ShowS)
-> (MkDayExtra p -> String)
-> ([MkDayExtra p] -> ShowS)
-> Show (MkDayExtra p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> MkDayExtra p -> ShowS
forall k (p :: k). [MkDayExtra p] -> ShowS
forall k (p :: k). MkDayExtra p -> String
showList :: [MkDayExtra p] -> ShowS
$cshowList :: forall k (p :: k). [MkDayExtra p] -> ShowS
show :: MkDayExtra p -> String
$cshow :: forall k (p :: k). MkDayExtra p -> String
showsPrec :: Int -> MkDayExtra p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> MkDayExtra p -> ShowS
Show
type MkDayExtraT p = p >> MkDayExtra' Fst Snd Thd

instance P (MkDayExtraT p) x => P (MkDayExtra p) x where
  type PP (MkDayExtra p) x = PP (MkDayExtraT p) x
  eval :: proxy (MkDayExtra p) -> POpts -> x -> m (TT (PP (MkDayExtra p) x))
eval proxy (MkDayExtra p)
_ = Proxy (MkDayExtraT p)
-> POpts -> x -> m (TT (PP (MkDayExtraT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MkDayExtraT p)
forall k (t :: k). Proxy t
Proxy @(MkDayExtraT p))

-- | get the day of the week

--

-- >>> pz @('Just (MkDay '(2020,7,11)) >> '(UnMkDay Id, ToWeekYear Id,ToWeekDate Id)) ()

-- Val ((2020,7,11),28,(6,"Saturday"))

--

data ToWeekDate p deriving Int -> ToWeekDate p -> ShowS
[ToWeekDate p] -> ShowS
ToWeekDate p -> String
(Int -> ToWeekDate p -> ShowS)
-> (ToWeekDate p -> String)
-> ([ToWeekDate p] -> ShowS)
-> Show (ToWeekDate p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ToWeekDate p -> ShowS
forall k (p :: k). [ToWeekDate p] -> ShowS
forall k (p :: k). ToWeekDate p -> String
showList :: [ToWeekDate p] -> ShowS
$cshowList :: forall k (p :: k). [ToWeekDate p] -> ShowS
show :: ToWeekDate p -> String
$cshow :: forall k (p :: k). ToWeekDate p -> String
showsPrec :: Int -> ToWeekDate p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ToWeekDate p -> ShowS
Show

instance ( P p x
         , PP p x ~ Day
         ) => P (ToWeekDate p) x where
  type PP (ToWeekDate p) x = (Int, String)
  eval :: proxy (ToWeekDate p) -> POpts -> x -> m (TT (PP (ToWeekDate p) x))
eval proxy (ToWeekDate p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ToWeekDate"
    TT Day
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (Int, String) -> m (TT (Int, String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Int, String) -> m (TT (Int, String)))
-> TT (Int, String) -> m (TT (Int, String))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Day
-> [Tree PE]
-> Either (TT (Int, String)) Day
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Day
pp [] of
      Left TT (Int, String)
e -> TT (Int, String)
e
      Right Day
p ->
        let (Integer
_, Int
_week, Int
dow) = Day -> (Integer, Int, Int)
toWeekDate Day
p
            dowString :: String
dowString = case Int
dow Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7 of
                          Int
0 -> String
"Sunday"
                          Int
1 -> String
"Monday"
                          Int
2 -> String
"Tuesday"
                          Int
3 -> String
"Wednesday"
                          Int
4 -> String
"Thursday"
                          Int
5 -> String
"Friday"
                          Int
6 -> String
"Saturday"
                          Int
o -> ShowS
forall x. HasCallStack => String -> x
errorInProgram ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"ToWeekDate:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
o
        in POpts
-> Val (Int, String) -> String -> [Tree PE] -> TT (Int, String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((Int, String) -> Val (Int, String)
forall a. a -> Val a
Val (Int
dow,String
dowString)) (POpts -> String -> Int -> Day -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Int
dow Day
p) [TT Day -> Tree PE
forall a. TT a -> Tree PE
hh TT Day
pp]

-- | get week number of the year

--

-- >>> pz @('Just (MkDay '(2020,7,11)) >> ToWeekYear Id) ()

-- Val 28

--

data ToWeekYear p deriving Int -> ToWeekYear p -> ShowS
[ToWeekYear p] -> ShowS
ToWeekYear p -> String
(Int -> ToWeekYear p -> ShowS)
-> (ToWeekYear p -> String)
-> ([ToWeekYear p] -> ShowS)
-> Show (ToWeekYear p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ToWeekYear p -> ShowS
forall k (p :: k). [ToWeekYear p] -> ShowS
forall k (p :: k). ToWeekYear p -> String
showList :: [ToWeekYear p] -> ShowS
$cshowList :: forall k (p :: k). [ToWeekYear p] -> ShowS
show :: ToWeekYear p -> String
$cshow :: forall k (p :: k). ToWeekYear p -> String
showsPrec :: Int -> ToWeekYear p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ToWeekYear p -> ShowS
Show

instance ( P p x
         , PP p x ~ Day
         ) => P (ToWeekYear p) x where
  type PP (ToWeekYear p) x = Int
  eval :: proxy (ToWeekYear p) -> POpts -> x -> m (TT (PP (ToWeekYear p) x))
eval proxy (ToWeekYear p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ToWeekYear"
    TT Day
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Day -> [Tree PE] -> Either (TT Int) Day
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Day
pp [] of
      Left TT Int
e -> TT Int
e
      Right Day
p ->
        let (Integer
_, Int
week, Int
_dow) = Day -> (Integer, Int, Int)
toWeekDate Day
p
        in POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
week) (POpts -> String -> Int -> Day -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Int
week Day
p) [TT Day -> Tree PE
forall a. TT a -> Tree PE
hh TT Day
pp]

class ToDayC (a :: Type) where
  getDay :: a -> Day
instance ToDayC UTCTime where
  getDay :: UTCTime -> Day
getDay = UTCTime -> Day
utctDay
instance ToDayC ZonedTime where
  getDay :: ZonedTime -> Day
getDay = LocalTime -> Day
forall a. ToDayC a => a -> Day
getDay (LocalTime -> Day) -> (ZonedTime -> LocalTime) -> ZonedTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime
instance ToDayC LocalTime where
  getDay :: LocalTime -> Day
getDay = LocalTime -> Day
localDay
instance ToDayC Day where
  getDay :: Day -> Day
getDay = Day -> Day
forall a. a -> a
id
instance ToDayC Rational where
  getDay :: Rational -> Day
getDay = UTCTime -> Day
forall a. ToDayC a => a -> Day
getDay (UTCTime -> Day) -> (Rational -> UTCTime) -> Rational -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
P.posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Rational -> POSIXTime) -> Rational -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational
instance ToDayC CP.SystemTime where
  getDay :: SystemTime -> Day
getDay = UTCTime -> Day
forall a. ToDayC a => a -> Day
getDay (UTCTime -> Day) -> (SystemTime -> UTCTime) -> SystemTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> UTCTime
CP.systemToUTCTime

class ToTimeC (a :: Type) where
  getTime :: a -> TimeOfDay
instance ToTimeC UTCTime where
  getTime :: UTCTime -> TimeOfDay
getTime = DiffTime -> TimeOfDay
forall a. ToTimeC a => a -> TimeOfDay
getTime (DiffTime -> TimeOfDay)
-> (UTCTime -> DiffTime) -> UTCTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> DiffTime
utctDayTime
instance ToTimeC ZonedTime where
  getTime :: ZonedTime -> TimeOfDay
getTime = LocalTime -> TimeOfDay
forall a. ToTimeC a => a -> TimeOfDay
getTime (LocalTime -> TimeOfDay)
-> (ZonedTime -> LocalTime) -> ZonedTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime
instance ToTimeC LocalTime where
  getTime :: LocalTime -> TimeOfDay
getTime = LocalTime -> TimeOfDay
localTimeOfDay
instance ToTimeC TimeOfDay where
  getTime :: TimeOfDay -> TimeOfDay
getTime = TimeOfDay -> TimeOfDay
forall a. a -> a
id
instance ToTimeC DiffTime where
  getTime :: DiffTime -> TimeOfDay
getTime = DiffTime -> TimeOfDay
timeToTimeOfDay
instance ToTimeC Rational where
  getTime :: Rational -> TimeOfDay
getTime = UTCTime -> TimeOfDay
forall a. ToTimeC a => a -> TimeOfDay
getTime (UTCTime -> TimeOfDay)
-> (Rational -> UTCTime) -> Rational -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
P.posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Rational -> POSIXTime) -> Rational -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational
instance ToTimeC CP.SystemTime where
  getTime :: SystemTime -> TimeOfDay
getTime = UTCTime -> TimeOfDay
forall a. ToTimeC a => a -> TimeOfDay
getTime (UTCTime -> TimeOfDay)
-> (SystemTime -> UTCTime) -> SystemTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemTime -> UTCTime
CP.systemToUTCTime

-- | extract 'Day' from a DateTime

--

-- >>> pz @(ReadP UTCTime Id >> ToDay) "2020-07-06 12:11:13Z"

-- Val 2020-07-06

--

data ToDay deriving Int -> ToDay -> ShowS
[ToDay] -> ShowS
ToDay -> String
(Int -> ToDay -> ShowS)
-> (ToDay -> String) -> ([ToDay] -> ShowS) -> Show ToDay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToDay] -> ShowS
$cshowList :: [ToDay] -> ShowS
show :: ToDay -> String
$cshow :: ToDay -> String
showsPrec :: Int -> ToDay -> ShowS
$cshowsPrec :: Int -> ToDay -> ShowS
Show
instance ( ToDayC x
         , Show x
         ) => P ToDay x where
  type PP ToDay x = Day
  eval :: proxy ToDay -> POpts -> x -> m (TT (PP ToDay x))
eval proxy ToDay
_ POpts
opts x
x =
    let msg0 :: String
msg0 = String
"ToDay"
        ret :: Day
ret = x -> Day
forall a. ToDayC a => a -> Day
getDay x
x
    in TT Day -> m (TT Day)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Day -> m (TT Day)) -> TT Day -> m (TT Day)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Day -> String -> [Tree PE] -> TT Day
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Day -> Val Day
forall a. a -> Val a
Val Day
ret) (POpts -> String -> Day -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Day
ret x
x) []

-- | extract 'TimeOfDay' from DateTime

--

-- >>> pz @(ReadP UTCTime Id >> ToTime) "2020-07-06 12:11:13Z"

-- Val 12:11:13

--

data ToTime deriving Int -> ToTime -> ShowS
[ToTime] -> ShowS
ToTime -> String
(Int -> ToTime -> ShowS)
-> (ToTime -> String) -> ([ToTime] -> ShowS) -> Show ToTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToTime] -> ShowS
$cshowList :: [ToTime] -> ShowS
show :: ToTime -> String
$cshow :: ToTime -> String
showsPrec :: Int -> ToTime -> ShowS
$cshowsPrec :: Int -> ToTime -> ShowS
Show

instance ( ToTimeC x
         , Show x
         ) => P ToTime x where
  type PP ToTime x = TimeOfDay
  eval :: proxy ToTime -> POpts -> x -> m (TT (PP ToTime x))
eval proxy ToTime
_ POpts
opts x
x =
    let msg0 :: String
msg0 = String
"ToTime"
        ret :: TimeOfDay
ret = x -> TimeOfDay
forall a. ToTimeC a => a -> TimeOfDay
getTime x
x
    in TT TimeOfDay -> m (TT TimeOfDay)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT TimeOfDay -> m (TT TimeOfDay))
-> TT TimeOfDay -> m (TT TimeOfDay)
forall a b. (a -> b) -> a -> b
$ POpts -> Val TimeOfDay -> String -> [Tree PE] -> TT TimeOfDay
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (TimeOfDay -> Val TimeOfDay
forall a. a -> Val a
Val TimeOfDay
ret) (POpts -> String -> TimeOfDay -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 TimeOfDay
ret x
x) []


-- | create a 'TimeOfDay' from three int values passed in as year month and day

--

-- >>> pz @(MkTime' Fst Snd Thd) (13,99,99999)

-- Val 13:99:99999

--

data MkTime' p q r deriving Int -> MkTime' p q r -> ShowS
[MkTime' p q r] -> ShowS
MkTime' p q r -> String
(Int -> MkTime' p q r -> ShowS)
-> (MkTime' p q r -> String)
-> ([MkTime' p q r] -> ShowS)
-> Show (MkTime' p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkTime' p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [MkTime' p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). MkTime' p q r -> String
showList :: [MkTime' p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [MkTime' p q r] -> ShowS
show :: MkTime' p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). MkTime' p q r -> String
showsPrec :: Int -> MkTime' p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> MkTime' p q r -> ShowS
Show

instance ( P p x
         , P q x
         , P r x
         , PP p x ~ Int
         , PP q x ~ Int
         , PP r x ~ Rational
         ) => P (MkTime' p q r) x where
  type PP (MkTime' p q r) x = TimeOfDay
  eval :: proxy (MkTime' p q r)
-> POpts -> x -> m (TT (PP (MkTime' p q r) x))
eval proxy (MkTime' p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"MkTime"
    Either (TT TimeOfDay) (Int, Int, TT Int, TT Int)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT TimeOfDay) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    case Either (TT TimeOfDay) (Int, Int, TT Int, TT Int)
lr of
      Left TT TimeOfDay
e -> TT TimeOfDay -> m (TT TimeOfDay)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT TimeOfDay
e
      Right (Int
p,Int
q,TT Int
pp,TT Int
qq) -> do
        let hhs :: [Tree PE]
hhs = [TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
pp, TT Int -> Tree PE
forall a. TT a -> Tree PE
hh TT Int
qq]
        TT Rational
rr <- Proxy r -> POpts -> x -> m (TT (PP r x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
        TT TimeOfDay -> m (TT TimeOfDay)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT TimeOfDay -> m (TT TimeOfDay))
-> TT TimeOfDay -> m (TT TimeOfDay)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Rational
-> [Tree PE]
-> Either (TT TimeOfDay) Rational
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Rational
rr [Tree PE]
hhs of
          Left TT TimeOfDay
e -> TT TimeOfDay
e
          Right Rational
r ->
            let mtime :: TimeOfDay
mtime = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
p Int
q (Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational Rational
r)
            in POpts -> Val TimeOfDay -> String -> [Tree PE] -> TT TimeOfDay
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (TimeOfDay -> Val TimeOfDay
forall a. a -> Val a
Val TimeOfDay
mtime) (POpts
-> String -> TimeOfDay -> String -> (Int, Int, Rational) -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 TimeOfDay
mtime String
"(h,m,s)=" (Int
p,Int
q,Rational
r)) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT Rational -> Tree PE
forall a. TT a -> Tree PE
hh TT Rational
rr])

-- | create a 'TimeOfDay' from a three-tuple of year month and day

--

-- >>> pz @(MkTime '(1,2,3 % 12345)) ()

-- Val 01:02:00.000243013365

--

-- >>> pz @(MkTime Id) (12,13,65)

-- Val 12:13:65

--

-- >>> pz @(MkTime Id) (17,3,13)

-- Val 17:03:13

--

data MkTime p deriving Int -> MkTime p -> ShowS
[MkTime p] -> ShowS
MkTime p -> String
(Int -> MkTime p -> ShowS)
-> (MkTime p -> String) -> ([MkTime p] -> ShowS) -> Show (MkTime p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> MkTime p -> ShowS
forall k (p :: k). [MkTime p] -> ShowS
forall k (p :: k). MkTime p -> String
showList :: [MkTime p] -> ShowS
$cshowList :: forall k (p :: k). [MkTime p] -> ShowS
show :: MkTime p -> String
$cshow :: forall k (p :: k). MkTime p -> String
showsPrec :: Int -> MkTime p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> MkTime p -> ShowS
Show
type MkTimeT p = p >> MkTime' Fst Snd Thd

instance P (MkTimeT p) x => P (MkTime p) x where
  type PP (MkTime p) x = PP (MkTimeT p) x
  eval :: proxy (MkTime p) -> POpts -> x -> m (TT (PP (MkTime p) x))
eval proxy (MkTime p)
_ = Proxy (MkTimeT p) -> POpts -> x -> m (TT (PP (MkTimeT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MkTimeT p)
forall k (t :: k). Proxy t
Proxy @(MkTimeT p))


-- | uncreate a 'TimeOfDay' returning hour minute seconds picoseconds

--

-- >>> pz @(ReadP UTCTime "2019-01-01 12:13:14.1234Z" >> ToTime >> UnMkTime Id) ()

-- Val (12,13,70617 % 5000)

--

-- >>> pz @(ReadP UTCTime Id >> ToTime >> UnMkTime Id) "2020-07-22 08:01:14.127Z"

-- Val (8,1,14127 % 1000)

--

-- >>> pz @(ReadP ZonedTime Id >> '(UnMkDay ToDay, UnMkTime ToTime)) "2020-07-11 11:41:12.333+0400"

-- Val ((2020,7,11),(11,41,12333 % 1000))

--

data UnMkTime p deriving Int -> UnMkTime p -> ShowS
[UnMkTime p] -> ShowS
UnMkTime p -> String
(Int -> UnMkTime p -> ShowS)
-> (UnMkTime p -> String)
-> ([UnMkTime p] -> ShowS)
-> Show (UnMkTime p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> UnMkTime p -> ShowS
forall k (p :: k). [UnMkTime p] -> ShowS
forall k (p :: k). UnMkTime p -> String
showList :: [UnMkTime p] -> ShowS
$cshowList :: forall k (p :: k). [UnMkTime p] -> ShowS
show :: UnMkTime p -> String
$cshow :: forall k (p :: k). UnMkTime p -> String
showsPrec :: Int -> UnMkTime p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> UnMkTime p -> ShowS
Show

instance ( PP p x ~ TimeOfDay
         , P p x
         ) => P (UnMkTime p) x where
  type PP (UnMkTime p) x = (Int, Int, Rational)
  eval :: proxy (UnMkTime p) -> POpts -> x -> m (TT (PP (UnMkTime p) x))
eval proxy (UnMkTime p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"UnMkTime"
    TT TimeOfDay
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (Int, Int, Rational) -> m (TT (Int, Int, Rational))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Int, Int, Rational) -> m (TT (Int, Int, Rational)))
-> TT (Int, Int, Rational) -> m (TT (Int, Int, Rational))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT TimeOfDay
-> [Tree PE]
-> Either (TT (Int, Int, Rational)) TimeOfDay
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT TimeOfDay
pp [] of
      Left TT (Int, Int, Rational)
e -> TT (Int, Int, Rational)
e
      Right TimeOfDay
p ->
        let TimeOfDay Int
h Int
m Pico
s = TimeOfDay
p
            b :: (Int, Int, Rational)
b = (Int
h, Int
m, Pico -> Rational
forall a. Real a => a -> Rational
toRational Pico
s)
        in POpts
-> Val (Int, Int, Rational)
-> String
-> [Tree PE]
-> TT (Int, Int, Rational)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((Int, Int, Rational) -> Val (Int, Int, Rational)
forall a. a -> Val a
Val (Int, Int, Rational)
b) (POpts -> String -> (Int, Int, Rational) -> TimeOfDay -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 (Int, Int, Rational)
b TimeOfDay
p) [TT TimeOfDay -> Tree PE
forall a. TT a -> Tree PE
hh TT TimeOfDay
pp]


-- microsoft json date is x*1000 ie milliseconds


-- | convert posix time (seconds since 01-01-1970) to 'UTCTime'

--

-- >>> pl @(PosixToUTCTime Id) 1593384312

-- Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)

-- Val 2020-06-28 22:45:12 UTC

--

-- >>> pl @(PosixToUTCTime Id >> UTCTimeToPosix Id) 1593384312

-- Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})

-- Val (1593384312 % 1)

--

-- >>> pl @(PosixToUTCTime (Id % 1000)) 1593384312000

-- Present 2020-06-28 22:45:12 UTC (PosixToUTCTime 2020-06-28 22:45:12 UTC | 1593384312 % 1)

-- Val 2020-06-28 22:45:12 UTC

--

-- >>> pl @(PosixToUTCTime Id) (3600*4+60*7+12)

-- Present 1970-01-01 04:07:12 UTC (PosixToUTCTime 1970-01-01 04:07:12 UTC | 14832 % 1)

-- Val 1970-01-01 04:07:12 UTC

--

-- >>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" >> Head >> Snd >> ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) "Date(1530144000000+0530)"

-- Val 2018-06-28 00:00:00 UTC

--

data PosixToUTCTime p deriving Int -> PosixToUTCTime p -> ShowS
[PosixToUTCTime p] -> ShowS
PosixToUTCTime p -> String
(Int -> PosixToUTCTime p -> ShowS)
-> (PosixToUTCTime p -> String)
-> ([PosixToUTCTime p] -> ShowS)
-> Show (PosixToUTCTime p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> PosixToUTCTime p -> ShowS
forall k (p :: k). [PosixToUTCTime p] -> ShowS
forall k (p :: k). PosixToUTCTime p -> String
showList :: [PosixToUTCTime p] -> ShowS
$cshowList :: forall k (p :: k). [PosixToUTCTime p] -> ShowS
show :: PosixToUTCTime p -> String
$cshow :: forall k (p :: k). PosixToUTCTime p -> String
showsPrec :: Int -> PosixToUTCTime p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> PosixToUTCTime p -> ShowS
Show

instance ( PP p x ~ Rational
         , P p x
         ) => P (PosixToUTCTime p) x where
  type PP (PosixToUTCTime p) x = UTCTime
  eval :: proxy (PosixToUTCTime p)
-> POpts -> x -> m (TT (PP (PosixToUTCTime p) x))
eval proxy (PosixToUTCTime p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"PosixToUTCTime"
    TT Rational
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT UTCTime -> m (TT UTCTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT UTCTime -> m (TT UTCTime)) -> TT UTCTime -> m (TT UTCTime)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Rational
-> [Tree PE]
-> Either (TT UTCTime) Rational
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Rational
pp [] of
      Left TT UTCTime
e -> TT UTCTime
e
      Right Rational
p ->
        let d :: UTCTime
d = POSIXTime -> UTCTime
P.posixSecondsToUTCTime (Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational Rational
p)
        in POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (UTCTime -> Val UTCTime
forall a. a -> Val a
Val UTCTime
d) (POpts -> String -> UTCTime -> Rational -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 UTCTime
d Rational
p) [TT Rational -> Tree PE
forall a. TT a -> Tree PE
hh TT Rational
pp]

-- | convert 'UTCTime' to posix time (seconds since 01-01-1970)

--

-- >>> pl @(ReadP UTCTime Id >> UTCTimeToPosix Id) "2020-06-28 22:45:12 UTC"

-- Present 1593384312 % 1 ((>>) 1593384312 % 1 | {UTCTimeToPosix 1593384312 % 1 | 2020-06-28 22:45:12 UTC})

-- Val (1593384312 % 1)

--

-- >>> pz @(Rescan "^Date\\((\\d+)([^\\)]+)\\)" >> Head >> Snd >> ((ReadP Integer (Id !! 0) >> PosixToUTCTime (Id % 1000)) &&& ReadP TimeZone (Id !! 1))) "Date(1530144000000+0530)"

-- Val (2018-06-28 00:00:00 UTC,+0530)

--

data UTCTimeToPosix p deriving Int -> UTCTimeToPosix p -> ShowS
[UTCTimeToPosix p] -> ShowS
UTCTimeToPosix p -> String
(Int -> UTCTimeToPosix p -> ShowS)
-> (UTCTimeToPosix p -> String)
-> ([UTCTimeToPosix p] -> ShowS)
-> Show (UTCTimeToPosix p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> UTCTimeToPosix p -> ShowS
forall k (p :: k). [UTCTimeToPosix p] -> ShowS
forall k (p :: k). UTCTimeToPosix p -> String
showList :: [UTCTimeToPosix p] -> ShowS
$cshowList :: forall k (p :: k). [UTCTimeToPosix p] -> ShowS
show :: UTCTimeToPosix p -> String
$cshow :: forall k (p :: k). UTCTimeToPosix p -> String
showsPrec :: Int -> UTCTimeToPosix p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> UTCTimeToPosix p -> ShowS
Show

instance ( PP p x ~ UTCTime
         , P p x
         ) => P (UTCTimeToPosix p) x where
  type PP (UTCTimeToPosix p) x = Rational
  eval :: proxy (UTCTimeToPosix p)
-> POpts -> x -> m (TT (PP (UTCTimeToPosix p) x))
eval proxy (UTCTimeToPosix p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"UTCTimeToPosix"
    TT UTCTime
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT Rational -> m (TT Rational)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Rational -> m (TT Rational)) -> TT Rational -> m (TT Rational)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT UTCTime
-> [Tree PE]
-> Either (TT Rational) UTCTime
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT UTCTime
pp [] of
      Left TT Rational
e -> TT Rational
e
      Right UTCTime
p ->
        let d :: Rational
d = POSIXTime -> Rational
forall a. Real a => a -> Rational
toRational (POSIXTime -> Rational) -> POSIXTime -> Rational
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
P.utcTimeToPOSIXSeconds UTCTime
p
        in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Rational -> Val Rational
forall a. a -> Val a
Val Rational
d) (POpts -> String -> Rational -> UTCTime -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Rational
d UTCTime
p) [TT UTCTime -> Tree PE
forall a. TT a -> Tree PE
hh TT UTCTime
pp]


-- | similar to 'Data.Time.diffUTCTime'

--

-- >>> pz @(DiffUTCTime Fst Snd) (read "2020-11-08 12:12:03Z", read "2020-11-08 11:12:00Z")

-- Val 3603s

--

data DiffUTCTime p q deriving Int -> DiffUTCTime p q -> ShowS
[DiffUTCTime p q] -> ShowS
DiffUTCTime p q -> String
(Int -> DiffUTCTime p q -> ShowS)
-> (DiffUTCTime p q -> String)
-> ([DiffUTCTime p q] -> ShowS)
-> Show (DiffUTCTime p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> DiffUTCTime p q -> ShowS
forall k (p :: k) k (q :: k). [DiffUTCTime p q] -> ShowS
forall k (p :: k) k (q :: k). DiffUTCTime p q -> String
showList :: [DiffUTCTime p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [DiffUTCTime p q] -> ShowS
show :: DiffUTCTime p q -> String
$cshow :: forall k (p :: k) k (q :: k). DiffUTCTime p q -> String
showsPrec :: Int -> DiffUTCTime p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> DiffUTCTime p q -> ShowS
Show

instance ( PP p x ~ UTCTime
         , PP q x ~ UTCTime
         , P p x
         , P q x
         ) => P (DiffUTCTime p q) x where
  type PP (DiffUTCTime p q) x = NominalDiffTime
  eval :: proxy (DiffUTCTime p q)
-> POpts -> x -> m (TT (PP (DiffUTCTime p q) x))
eval proxy (DiffUTCTime p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"DiffUTCTime"
    Either (TT POSIXTime) (UTCTime, UTCTime, TT UTCTime, TT UTCTime)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT POSIXTime) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT POSIXTime -> m (TT POSIXTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT POSIXTime -> m (TT POSIXTime))
-> TT POSIXTime -> m (TT POSIXTime)
forall a b. (a -> b) -> a -> b
$ case Either (TT POSIXTime) (UTCTime, UTCTime, TT UTCTime, TT UTCTime)
lr of
      Left TT POSIXTime
e -> TT POSIXTime
e
      Right (UTCTime
p,UTCTime
q,TT UTCTime
pp,TT UTCTime
qq) ->
        let b :: POSIXTime
b = UTCTime -> UTCTime -> POSIXTime
diffUTCTime UTCTime
p UTCTime
q
        in POpts -> Val POSIXTime -> String -> [Tree PE] -> TT POSIXTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (POSIXTime -> Val POSIXTime
forall a. a -> Val a
Val POSIXTime
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> POSIXTime -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts POSIXTime
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> UTCTime -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " UTCTime
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> UTCTime -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " UTCTime
q) [TT UTCTime -> Tree PE
forall a. TT a -> Tree PE
hh TT UTCTime
pp, TT UTCTime -> Tree PE
forall a. TT a -> Tree PE
hh TT UTCTime
qq]

-- | similar to 'Data.Time.diffLocalTime'

--

-- >>> pz @(DiffLocalTime Fst Snd) (read "2020-11-08 12:12:03", read "2020-11-05 15:12:00")

-- Val 248403s

--

data DiffLocalTime p q deriving Int -> DiffLocalTime p q -> ShowS
[DiffLocalTime p q] -> ShowS
DiffLocalTime p q -> String
(Int -> DiffLocalTime p q -> ShowS)
-> (DiffLocalTime p q -> String)
-> ([DiffLocalTime p q] -> ShowS)
-> Show (DiffLocalTime p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> DiffLocalTime p q -> ShowS
forall k (p :: k) k (q :: k). [DiffLocalTime p q] -> ShowS
forall k (p :: k) k (q :: k). DiffLocalTime p q -> String
showList :: [DiffLocalTime p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [DiffLocalTime p q] -> ShowS
show :: DiffLocalTime p q -> String
$cshow :: forall k (p :: k) k (q :: k). DiffLocalTime p q -> String
showsPrec :: Int -> DiffLocalTime p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> DiffLocalTime p q -> ShowS
Show
type DiffLocalTimeT p q = DiffUTCTime (LocalTimeToUTC p) (LocalTimeToUTC q)

instance P (DiffLocalTimeT p q) x => P (DiffLocalTime p q) x where
  type PP (DiffLocalTime p q) x = PP (DiffLocalTimeT p q) x
  eval :: proxy (DiffLocalTime p q)
-> POpts -> x -> m (TT (PP (DiffLocalTime p q) x))
eval proxy (DiffLocalTime p q)
_ = Proxy (DiffLocalTimeT p q)
-> POpts -> x -> m (TT (PP (DiffLocalTimeT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (DiffLocalTimeT p q)
forall k (t :: k). Proxy t
Proxy @(DiffLocalTimeT p q))


-- | similar to 'Data.Time.localTimeToUTC'

data LocalTimeToUTC p deriving Int -> LocalTimeToUTC p -> ShowS
[LocalTimeToUTC p] -> ShowS
LocalTimeToUTC p -> String
(Int -> LocalTimeToUTC p -> ShowS)
-> (LocalTimeToUTC p -> String)
-> ([LocalTimeToUTC p] -> ShowS)
-> Show (LocalTimeToUTC p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> LocalTimeToUTC p -> ShowS
forall k (p :: k). [LocalTimeToUTC p] -> ShowS
forall k (p :: k). LocalTimeToUTC p -> String
showList :: [LocalTimeToUTC p] -> ShowS
$cshowList :: forall k (p :: k). [LocalTimeToUTC p] -> ShowS
show :: LocalTimeToUTC p -> String
$cshow :: forall k (p :: k). LocalTimeToUTC p -> String
showsPrec :: Int -> LocalTimeToUTC p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> LocalTimeToUTC p -> ShowS
Show

instance ( PP p x ~ LocalTime
         , P p x
         ) => P (LocalTimeToUTC p) x where
  type PP (LocalTimeToUTC p) x = UTCTime
  eval :: proxy (LocalTimeToUTC p)
-> POpts -> x -> m (TT (PP (LocalTimeToUTC p) x))
eval proxy (LocalTimeToUTC p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"LocalTimeToUTC"
    TT LocalTime
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT UTCTime -> m (TT UTCTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT UTCTime -> m (TT UTCTime)) -> TT UTCTime -> m (TT UTCTime)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT LocalTime
-> [Tree PE]
-> Either (TT UTCTime) LocalTime
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT LocalTime
pp [] of
      Left TT UTCTime
e -> TT UTCTime
e
      Right LocalTime
p ->
        let d :: UTCTime
d = TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc LocalTime
p
        in POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (UTCTime -> Val UTCTime
forall a. a -> Val a
Val UTCTime
d) (POpts -> String -> UTCTime -> LocalTime -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 UTCTime
d LocalTime
p) [TT LocalTime -> Tree PE
forall a. TT a -> Tree PE
hh TT LocalTime
pp]