{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-|
Module:      TextShow.Data.Time
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

'TextShow' instances for data types in the @time@ library.

/Since: 2/
-}
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 #-}

-- | /Since: 2/
instance TextShow Day where
    showb :: Day -> Builder
showb = Day -> Builder
showbGregorian
    {-# INLINE showb #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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" -- ugly, but standard apparently
    {-# INLINE showb #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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 #-}

-- | /Since: 2/
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 #-}

-- | /Since: 3.6/
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 #-}

-- | /Since: 2/
$(deriveTextShow ''TimeLocale)

#if MIN_VERSION_time(1,8,0)
-- | Only available with @time-1.8@ or later.
--
-- /Since: 3.6/
$(deriveTextShow ''SystemTime)
#endif