{-# language BangPatterns #-}
{-# language NumericUnderscores #-}
{-# language OverloadedStrings #-}
{-# language PatternSynonyms #-}
{-# language PartialTypeSignatures #-}
{-# language TypeApplications #-}
{-# language ViewPatterns #-}

{-# options_ghc -Wno-partial-type-signatures #-}
-- bytestring does not export Monoidal so we can't write a complete type
-- signature for 'divide'

{-# options_ghc -Wno-unused-top-binds #-}
-- GHC considers the YMD pattern unused but we use its selectors

module Rel8.Type.Builder.Time (
  calendarDiffTime,
  day,
  localTime,
  timeOfDay,
  utcTime,
) where

-- base
import Data.Char (chr)
import Data.Fixed (Fixed (MkFixed), Pico)
import Data.Int (Int32, Int64)
import Prelude hiding ((<>))

-- bytestring
import Data.ByteString.Builder (Builder, string7)
import Data.ByteString.Builder.Prim (
  BoundedPrim, condB, emptyB, liftFixedToBounded,
  FixedPrim, char8, int32Dec,
  (>$<), (>*<),
 )

-- time
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Clock (UTCTime (utctDay, utctDayTime))
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Time.LocalTime (
  CalendarDiffTime,
  LocalTime (localDay, localTimeOfDay),
  TimeOfDay (todHour, todMin, todSec),
  timeToTimeOfDay
 )


digit :: FixedPrim Int
digit :: FixedPrim Int
digit = (\Int
x -> Int -> Char
chr (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)) (Int -> Char) -> FixedPrim Char -> FixedPrim Int
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
char8


digits2 :: FixedPrim Int
digits2 :: FixedPrim Int
digits2 = (Int -> (Int, Int))
-> FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) FixedPrim Int
digit FixedPrim Int
digit


digits3 :: FixedPrim Int
digits3 :: FixedPrim Int
digits3 = (Int -> (Int, Int))
-> FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) FixedPrim Int
digits2 FixedPrim Int
digit


digits4 :: FixedPrim Int
digits4 :: FixedPrim Int
digits4 = (Int -> (Int, Int))
-> FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) FixedPrim Int
digits3 FixedPrim Int
digit


frac :: BoundedPrim Int64
frac :: BoundedPrim Int64
frac = (Int64 -> Bool)
-> BoundedPrim Int64 -> BoundedPrim Int64 -> BoundedPrim Int64
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0) BoundedPrim Int64
forall a. BoundedPrim a
emptyB (BoundedPrim Int64 -> BoundedPrim Int64)
-> BoundedPrim Int64 -> BoundedPrim Int64
forall a b. (a -> b) -> a -> b
$ FixedPrim Int64 -> BoundedPrim Int64
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Char -> FixedPrim Int64
forall a. Char -> FixedPrim a
char Char
'.') BoundedPrim Int64 -> BoundedPrim Int64 -> BoundedPrim Int64
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> BoundedPrim Int64
trunc12
  where
    trunc12 :: BoundedPrim Int64
trunc12 =
      (Int64 -> (Int64, Int64))
-> BoundedPrim Int64 -> BoundedPrim Int64 -> BoundedPrim Int64
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide
        (Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
1_000_000)
        (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> BoundedPrim Int -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
ifZero BoundedPrim Int
trunc6 (FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Int
digits6))
        (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> BoundedPrim Int -> BoundedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int -> BoundedPrim Int
nonZero BoundedPrim Int
trunc6)

    digitB :: BoundedPrim Int
digitB = FixedPrim Int -> BoundedPrim Int
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Int
digit

    digits6 :: FixedPrim Int
digits6 = (Int -> (Int, Int))
-> FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) FixedPrim Int
digits5 FixedPrim Int
digit
    digits5 :: FixedPrim Int
digits5 = (Int -> (Int, Int))
-> FixedPrim Int -> FixedPrim Int -> FixedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) FixedPrim Int
digits4 FixedPrim Int
digit

    trunc6 :: BoundedPrim Int
trunc6 = (Int -> (Int, Int))
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100_000) BoundedPrim Int
digitB BoundedPrim Int
trunc5
    trunc5 :: BoundedPrim Int
trunc5 = BoundedPrim Int -> BoundedPrim Int
nonZero (BoundedPrim Int -> BoundedPrim Int)
-> BoundedPrim Int -> BoundedPrim Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int))
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10_000) BoundedPrim Int
digitB BoundedPrim Int
trunc4
    trunc4 :: BoundedPrim Int
trunc4 = BoundedPrim Int -> BoundedPrim Int
nonZero (BoundedPrim Int -> BoundedPrim Int)
-> BoundedPrim Int -> BoundedPrim Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int))
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
1_000) BoundedPrim Int
digitB BoundedPrim Int
trunc3
    trunc3 :: BoundedPrim Int
trunc3 = BoundedPrim Int -> BoundedPrim Int
nonZero (BoundedPrim Int -> BoundedPrim Int)
-> BoundedPrim Int -> BoundedPrim Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int))
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100) BoundedPrim Int
digitB BoundedPrim Int
trunc2
    trunc2 :: BoundedPrim Int
trunc2 = BoundedPrim Int -> BoundedPrim Int
nonZero (BoundedPrim Int -> BoundedPrim Int)
-> BoundedPrim Int -> BoundedPrim Int
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, Int))
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10) BoundedPrim Int
digitB BoundedPrim Int
trunc1
    trunc1 :: BoundedPrim Int
trunc1 = BoundedPrim Int -> BoundedPrim Int
nonZero BoundedPrim Int
digitB

    nonZero :: BoundedPrim Int -> BoundedPrim Int
nonZero = BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
ifZero BoundedPrim Int
forall a. BoundedPrim a
emptyB
    ifZero :: BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
ifZero = (Int -> Bool)
-> BoundedPrim Int -> BoundedPrim Int -> BoundedPrim Int
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)


seconds :: BoundedPrim Pico
seconds :: BoundedPrim Pico
seconds =
  (\(MkFixed Integer
s) -> Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
1_000_000_000_000) (Pico -> (Int64, Int64))
-> BoundedPrim (Int64, Int64) -> BoundedPrim Pico
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
  (FixedPrim Int64 -> BoundedPrim Int64
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> FixedPrim Int -> FixedPrim Int64
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2) BoundedPrim Int64
-> BoundedPrim Int64 -> BoundedPrim (Int64, Int64)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Int64
frac)


year :: BoundedPrim Int32
year :: BoundedPrim Int32
year = (Int32 -> Bool)
-> BoundedPrim Int32 -> BoundedPrim Int32 -> BoundedPrim Int32
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
10000) BoundedPrim Int32
int32Dec (FixedPrim Int32 -> BoundedPrim Int32
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> FixedPrim Int -> FixedPrim Int32
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits4))


day :: BoundedPrim Day
day :: BoundedPrim Day
day =
  (Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> (Day -> Integer) -> Day -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
ymdYear (Day -> Int32) -> BoundedPrim Int32 -> BoundedPrim Day
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Int32
year) BoundedPrim Day -> BoundedPrim Day -> BoundedPrim Day
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  FixedPrim Day -> BoundedPrim Day
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
    ( Char -> FixedPrim Day
forall a. Char -> FixedPrim a
char Char
'-' FixedPrim Day -> FixedPrim Day -> FixedPrim Day
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> (Day -> Int
ymdMonth (Day -> Int) -> FixedPrim Int -> FixedPrim Day
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2) FixedPrim Day -> FixedPrim Day -> FixedPrim Day
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> Char -> FixedPrim Day
forall a. Char -> FixedPrim a
char Char
'-' FixedPrim Day -> FixedPrim Day -> FixedPrim Day
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> (Day -> Int
ymdDay (Day -> Int) -> FixedPrim Int -> FixedPrim Day
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2)
    )


pattern YMD :: Integer -> Int -> Int -> Day
pattern $mYMD :: forall {r}.
Day -> (Integer -> Int -> Int -> r) -> ((# #) -> r) -> r
YMD {Day -> Integer
ymdYear, Day -> Int
ymdMonth, Day -> Int
ymdDay} <-
  (toGregorian -> (ymdYear, ymdMonth, ymdDay))


timeOfDay :: BoundedPrim TimeOfDay
timeOfDay :: BoundedPrim TimeOfDay
timeOfDay =
  FixedPrim TimeOfDay -> BoundedPrim TimeOfDay
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded
    ( (TimeOfDay -> Int
todHour (TimeOfDay -> Int) -> FixedPrim Int -> FixedPrim TimeOfDay
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2) FixedPrim TimeOfDay -> FixedPrim TimeOfDay -> FixedPrim TimeOfDay
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> Char -> FixedPrim TimeOfDay
forall a. Char -> FixedPrim a
char Char
':' FixedPrim TimeOfDay -> FixedPrim TimeOfDay -> FixedPrim TimeOfDay
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> (TimeOfDay -> Int
todMin (TimeOfDay -> Int) -> FixedPrim Int -> FixedPrim TimeOfDay
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Int
digits2) FixedPrim TimeOfDay -> FixedPrim TimeOfDay -> FixedPrim TimeOfDay
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<> Char -> FixedPrim TimeOfDay
forall a. Char -> FixedPrim a
char Char
':'
    ) BoundedPrim TimeOfDay
-> BoundedPrim TimeOfDay -> BoundedPrim TimeOfDay
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  (TimeOfDay -> Pico
todSec (TimeOfDay -> Pico) -> BoundedPrim Pico -> BoundedPrim TimeOfDay
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Pico
seconds)


utcTime :: BoundedPrim UTCTime
utcTime :: BoundedPrim UTCTime
utcTime =
  (UTCTime -> Day
utctDay (UTCTime -> Day) -> BoundedPrim Day -> BoundedPrim UTCTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Day
day) BoundedPrim UTCTime -> BoundedPrim UTCTime -> BoundedPrim UTCTime
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  FixedPrim UTCTime -> BoundedPrim UTCTime
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Char -> FixedPrim UTCTime
forall a. Char -> FixedPrim a
char Char
' ') BoundedPrim UTCTime -> BoundedPrim UTCTime -> BoundedPrim UTCTime
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  (DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay)
-> (UTCTime -> DiffTime) -> UTCTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> DiffTime
utctDayTime (UTCTime -> TimeOfDay)
-> BoundedPrim TimeOfDay -> BoundedPrim UTCTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim TimeOfDay
timeOfDay) BoundedPrim UTCTime -> BoundedPrim UTCTime -> BoundedPrim UTCTime
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  FixedPrim UTCTime -> BoundedPrim UTCTime
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Char -> FixedPrim UTCTime
forall a. Char -> FixedPrim a
char Char
'Z')


localTime :: BoundedPrim LocalTime
localTime :: BoundedPrim LocalTime
localTime =
  (LocalTime -> Day
localDay (LocalTime -> Day) -> BoundedPrim Day -> BoundedPrim LocalTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Day
day) BoundedPrim LocalTime
-> BoundedPrim LocalTime -> BoundedPrim LocalTime
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  FixedPrim LocalTime -> BoundedPrim LocalTime
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (Char -> FixedPrim LocalTime
forall a. Char -> FixedPrim a
char Char
' ') BoundedPrim LocalTime
-> BoundedPrim LocalTime -> BoundedPrim LocalTime
forall (f :: * -> *) a.
(Contravariant f, Monoidal f) =>
f a -> f a -> f a
<>
  (LocalTime -> TimeOfDay
localTimeOfDay (LocalTime -> TimeOfDay)
-> BoundedPrim TimeOfDay -> BoundedPrim LocalTime
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim TimeOfDay
timeOfDay)


calendarDiffTime :: CalendarDiffTime -> Builder
calendarDiffTime :: CalendarDiffTime -> Builder
calendarDiffTime = String -> Builder
string7 (String -> Builder)
-> (CalendarDiffTime -> String) -> CalendarDiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarDiffTime -> String
forall t. ISO8601 t => t -> String
iso8601Show


char :: Char -> FixedPrim a
char :: forall a. Char -> FixedPrim a
char Char
c = (\a
_ -> Char
c) (a -> Char) -> FixedPrim Char -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
char8


(<>) :: _ => f a -> f a -> f a
<> :: f a -> f a -> f a
(<>) = (a -> (a, a)) -> f a -> f a -> f a
forall a b c (f :: * -> *).
(Contravariant f, Monoidal f) =>
(a -> (b, c)) -> f b -> f c -> f a
divide (\a
a -> (a
a, a
a))
infixr 6 <>


divide :: _ => (a -> (b, c)) -> f b -> f c -> f a
divide :: (a -> (b, c)) -> f b -> f c -> f a
divide a -> (b, c)
f f b
a f c
b = a -> (b, c)
f (a -> (b, c)) -> f (b, c) -> f a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< (f b
a f b -> f c -> f (b, c)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< f c
b)