{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module TextShow.Data.Time () where
import Data.Fixed (Pico)
import Data.Semigroup (mtimesDefault)
import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime, UniversalTime)
import Data.Time.Clock.TAI (AbsoluteTime, taiToUTCTime)
import Data.Time.Format (TimeLocale)
import Data.Time.LocalTime (TimeZone(..), TimeOfDay(..), LocalTime(..), ZonedTime(..),
ut1ToLocalTime, utc, utcToLocalTime, utcToZonedTime)
import Prelude ()
import Prelude.Compat
import TextShow (TextShow(..), Builder, FromStringShow(..),
fromString, lengthB, showbSpace, singleton)
import TextShow.Data.Fixed (showbFixed)
import TextShow.Data.Integral ()
import TextShow.TH (deriveTextShow)
#if MIN_VERSION_time(1,7,0)
import Data.Maybe (fromJust)
#endif
#if MIN_VERSION_time(1,8,0)
import Data.Time.Clock.System (SystemTime)
#endif
type NumericPadOption = Maybe Char
pad1 :: NumericPadOption -> Builder -> Builder
pad1 :: NumericPadOption -> Builder -> Builder
pad1 (Just Char
c) Builder
b = Char -> Builder
singleton Char
c forall a. Semigroup a => a -> a -> a
<> Builder
b
pad1 NumericPadOption
_ Builder
b = Builder
b
{-# INLINE pad1 #-}
padN :: Int -> Char -> Builder -> Builder
padN :: Int -> Char -> Builder -> Builder
padN Int
i Char
_ Builder
b | Int
i forall a. Ord a => a -> a -> Bool
<= Int
0 = Builder
b
padN Int
i Char
c Builder
b = forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault Int
i (Char -> Builder
singleton Char
c) forall a. Semigroup a => a -> a -> a
<> Builder
b
{-# INLINE padN #-}
showb2 :: (Num t, Ord t, TextShow t) => NumericPadOption -> t -> Builder
showb2 :: forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 = forall t.
(Num t, Ord t, TextShow t) =>
Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
2
{-# INLINE showb2 #-}
showb2Fixed :: NumericPadOption -> Pico -> Builder
showb2Fixed :: NumericPadOption -> Pico -> Builder
showb2Fixed NumericPadOption
opt Pico
x | Pico
x forall a. Ord a => a -> a -> Bool
< Pico
10 = NumericPadOption -> Builder -> Builder
pad1 NumericPadOption
opt forall a b. (a -> b) -> a -> b
$ forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
True Pico
x
showb2Fixed NumericPadOption
_ Pico
x = forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
True Pico
x
{-# INLINE showb2Fixed #-}
showb4 :: (Num t, Ord t, TextShow t) => NumericPadOption -> t -> Builder
showb4 :: forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb4 = forall t.
(Num t, Ord t, TextShow t) =>
Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
4
{-# INLINE showb4 #-}
showbGregorian :: Day -> Builder
showbGregorian :: Day -> Builder
showbGregorian Day
date = forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb4 NumericPadOption
zeroOpt Year
y
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'-'
forall a. Semigroup a => a -> a -> a
<> forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
m
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'-'
forall a. Semigroup a => a -> a -> a
<> forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
d
where
(Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
date
showbPaddedMin :: (Num t, Ord t, TextShow t) => Int -> NumericPadOption -> t -> Builder
showbPaddedMin :: forall t.
(Num t, Ord t, TextShow t) =>
Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
_ NumericPadOption
Nothing t
i = forall a. TextShow a => a -> Builder
showb t
i
showbPaddedMin Int
pl NumericPadOption
opt t
i | t
i forall a. Ord a => a -> a -> Bool
< t
0 = Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> forall t.
(Num t, Ord t, TextShow t) =>
Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
pl NumericPadOption
opt (forall a. Num a => a -> a
negate t
i)
showbPaddedMin Int
pl (Just Char
c) t
i =
let b :: Builder
b = forall a. TextShow a => a -> Builder
showb t
i
in Int -> Char -> Builder -> Builder
padN (Int
pl forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral (Builder -> Int64
lengthB Builder
b)) Char
c Builder
b
showbT :: NumericPadOption -> Int -> Builder
showbT :: NumericPadOption -> Int -> Builder
showbT NumericPadOption
opt Int
t = forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb4 NumericPadOption
opt ((forall a. Integral a => a -> a -> a
div Int
t Int
60) forall a. Num a => a -> a -> a
* Int
100 forall a. Num a => a -> a -> a
+ (forall a. Integral a => a -> a -> a
mod Int
t Int
60))
{-# INLINE showbT #-}
timeZoneOffsetBuilder' :: NumericPadOption -> TimeZone -> Builder
timeZoneOffsetBuilder' :: NumericPadOption -> TimeZone -> Builder
timeZoneOffsetBuilder' NumericPadOption
opt (TimeZone Int
t Bool
_ String
_) | Int
t forall a. Ord a => a -> a -> Bool
< Int
0 = Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
showbT NumericPadOption
opt (forall a. Num a => a -> a
negate Int
t)
timeZoneOffsetBuilder' NumericPadOption
opt (TimeZone Int
t Bool
_ String
_) = Char -> Builder
singleton Char
'+' forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
showbT NumericPadOption
opt Int
t
{-# INLINE timeZoneOffsetBuilder' #-}
timeZoneOffsetBuilder :: TimeZone -> Builder
timeZoneOffsetBuilder :: TimeZone -> Builder
timeZoneOffsetBuilder = NumericPadOption -> TimeZone -> Builder
timeZoneOffsetBuilder' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Char
'0'
{-# INLINE timeZoneOffsetBuilder #-}
zeroOpt :: NumericPadOption
zeroOpt :: NumericPadOption
zeroOpt = forall a. a -> Maybe a
Just Char
'0'
{-# INLINE zeroOpt #-}
instance TextShow Day where
showb :: Day -> Builder
showb = Day -> Builder
showbGregorian
{-# INLINE showb #-}
instance TextShow DiffTime where
showb :: DiffTime -> Builder
showb = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromStringShow a
FromStringShow
{-# INLINE showb #-}
instance TextShow UTCTime where
showb :: UTCTime -> Builder
showb = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
utc
{-# INLINE showb #-}
instance TextShow NominalDiffTime where
showb :: NominalDiffTime -> Builder
showb = forall a. TextShow a => a -> Builder
showb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> FromStringShow a
FromStringShow
{-# INLINE showb #-}
instance TextShow AbsoluteTime where
showb :: AbsoluteTime -> Builder
showb AbsoluteTime
t = forall a. TextShow a => a -> Builder
showb (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_time(1,7,0)
forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
taiToUTCTime (forall a b. a -> b -> a
const (forall a. a -> Maybe a
Just Int
0)) AbsoluteTime
t)
#else
taiToUTCTime (const 0) t)
#endif
forall a. Semigroup a => a -> a -> a
<> Builder
" TAI"
{-# INLINE showb #-}
instance TextShow TimeZone where
showb :: TimeZone -> Builder
showb zone :: TimeZone
zone@(TimeZone Int
_ Bool
_ String
"") = TimeZone -> Builder
timeZoneOffsetBuilder TimeZone
zone
showb (TimeZone Int
_ Bool
_ String
name) = String -> Builder
fromString String
name
{-# INLINE showb #-}
instance TextShow TimeOfDay where
showb :: TimeOfDay -> Builder
showb (TimeOfDay Int
h Int
m Pico
sec) = forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
h
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
':'
forall a. Semigroup a => a -> a -> a
<> forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
m
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
':'
forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Pico -> Builder
showb2Fixed NumericPadOption
zeroOpt Pico
sec
{-# INLINE showb #-}
instance TextShow LocalTime where
showb :: LocalTime -> Builder
showb (LocalTime Day
d TimeOfDay
t) = Day -> Builder
showbGregorian Day
d forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb TimeOfDay
t
{-# INLINE showb #-}
instance TextShow ZonedTime where
showb :: ZonedTime -> Builder
showb (ZonedTime LocalTime
t TimeZone
zone) = forall a. TextShow a => a -> Builder
showb LocalTime
t forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace forall a. Semigroup a => a -> a -> a
<> forall a. TextShow a => a -> Builder
showb TimeZone
zone
{-# INLINE showb #-}
instance TextShow UniversalTime where
showb :: UniversalTime -> Builder
showb UniversalTime
t = forall a. TextShow a => a -> Builder
showb forall a b. (a -> b) -> a -> b
$ Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
t
{-# INLINE showb #-}
$(deriveTextShow ''TimeLocale)
#if MIN_VERSION_time(1,8,0)
$(deriveTextShow ''SystemTime)
#endif