{-# 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 #-}
module Predicate.Data.DateTime (
FormatTimeP
, FormatTimeP'
, ParseTimeP
, ParseTimeP'
, ParseTimes
, ParseTimes'
, MkDay
, MkDay'
, MkDayExtra
, MkDayExtra'
, MkTime
, MkTime'
, PosixToUTCTime
, DiffUTCTime
, DiffLocalTime
, 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
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
")"
b :: String
b = 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
b) (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
b 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]
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))
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
b -> 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
msg1 PP t a
b 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
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))
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
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))
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])
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))
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]
data 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])
data 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 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))
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]
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 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 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
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) []
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) []
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])
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))
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]
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]
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]
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]
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))
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]