{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
#if MIN_VERSION_time(1,5,0)
{-# LANGUAGE TemplateHaskell   #-}
#endif
{-# OPTIONS_GHC -fno-warn-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.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 ()

#if MIN_VERSION_time(1,5,0)
import Data.Time.Format (TimeLocale)
import TextShow.TH (deriveTextShow)
#endif

#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 Builder -> Builder -> Builder
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Builder
b
padN Int
i Char
c Builder
b          = Int -> Builder -> Builder
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault Int
i (Char -> Builder
singleton Char
c) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
{-# INLINE padN #-}

showb2 :: (Num t, Ord t, TextShow t) => NumericPadOption -> t -> Builder
showb2 :: NumericPadOption -> t -> Builder
showb2 = Int -> NumericPadOption -> t -> Builder
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 Pico -> Pico -> Bool
forall a. Ord a => a -> a -> Bool
< Pico
10 = NumericPadOption -> Builder -> Builder
pad1 NumericPadOption
opt (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Pico -> Builder
forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
True Pico
x
showb2Fixed NumericPadOption
_   Pico
x          = Bool -> Pico -> Builder
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 :: NumericPadOption -> t -> Builder
showb4 = Int -> NumericPadOption -> t -> Builder
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 = NumericPadOption -> Integer -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb4 NumericPadOption
zeroOpt Integer
y
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'-'
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
m
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'-'
                   Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2 NumericPadOption
zeroOpt Int
d
  where
    (Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
date

showbPaddedMin :: (Num t, Ord t, TextShow t) => Int -> NumericPadOption -> t -> Builder
showbPaddedMin :: Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
_  NumericPadOption
Nothing  t
i = t -> Builder
forall a. TextShow a => a -> Builder
showb t
i
showbPaddedMin Int
pl NumericPadOption
opt      t
i | t
i t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
0 = Char -> Builder
singleton Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> NumericPadOption -> t -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
Int -> NumericPadOption -> t -> Builder
showbPaddedMin Int
pl NumericPadOption
opt (t -> t
forall a. Num a => a -> a
negate t
i)
showbPaddedMin Int
pl (Just Char
c) t
i =
    let b :: Builder
b = t -> Builder
forall a. TextShow a => a -> Builder
showb t
i
    in Int -> Char -> Builder -> Builder
padN (Int
pl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int64 -> Int
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 = NumericPadOption -> Int -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb4 NumericPadOption
opt ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
t Int
60) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Char -> Builder
singleton Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
showbT NumericPadOption
opt (Int -> Int
forall a. Num a => a -> a
negate Int
t)
timeZoneOffsetBuilder' NumericPadOption
opt (TimeZone Int
t Bool
_ String
_) = Char -> Builder
singleton Char
'+' Builder -> Builder -> Builder
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' (NumericPadOption -> TimeZone -> Builder)
-> NumericPadOption -> TimeZone -> Builder
forall a b. (a -> b) -> a -> b
$ Char -> NumericPadOption
forall a. a -> Maybe a
Just Char
'0'
{-# INLINE timeZoneOffsetBuilder #-}

zeroOpt :: NumericPadOption
zeroOpt :: NumericPadOption
zeroOpt = Char -> NumericPadOption
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 = FromStringShow DiffTime -> Builder
forall a. TextShow a => a -> Builder
showb (FromStringShow DiffTime -> Builder)
-> (DiffTime -> FromStringShow DiffTime) -> DiffTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> FromStringShow DiffTime
forall a. a -> FromStringShow a
FromStringShow
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow UTCTime where
    showb :: UTCTime -> Builder
showb = ZonedTime -> Builder
forall a. TextShow a => a -> Builder
showb (ZonedTime -> Builder)
-> (UTCTime -> ZonedTime) -> UTCTime -> Builder
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 = FromStringShow NominalDiffTime -> Builder
forall a. TextShow a => a -> Builder
showb (FromStringShow NominalDiffTime -> Builder)
-> (NominalDiffTime -> FromStringShow NominalDiffTime)
-> NominalDiffTime
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> FromStringShow NominalDiffTime
forall a. a -> FromStringShow a
FromStringShow
    {-# INLINE showb #-}

-- | /Since: 2/
instance TextShow AbsoluteTime where
    showb :: AbsoluteTime -> Builder
showb AbsoluteTime
t = LocalTime -> Builder
forall a. TextShow a => a -> Builder
showb (TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc (UTCTime -> LocalTime) -> UTCTime -> LocalTime
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_time(1,7,0)
                                          Maybe UTCTime -> UTCTime
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UTCTime -> UTCTime) -> Maybe UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ LeapSecondMap -> AbsoluteTime -> Maybe UTCTime
taiToUTCTime (Maybe Int -> LeapSecondMap
forall a b. a -> b -> a
const (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)) AbsoluteTime
t)
#else
                                          taiToUTCTime (const 0) t)
#endif
              Builder -> Builder -> Builder
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) = NumericPadOption -> Int -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2      NumericPadOption
zeroOpt Int
h
                             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
':'
                             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NumericPadOption -> Int -> Builder
forall t.
(Num t, Ord t, TextShow t) =>
NumericPadOption -> t -> Builder
showb2      NumericPadOption
zeroOpt Int
m
                             Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
':'
                             Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeOfDay -> Builder
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) = LocalTime -> Builder
forall a. TextShow a => a -> Builder
showb LocalTime
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
showbSpace Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
forall a. TextShow a => a -> Builder
showb TimeZone
zone
    {-# INLINE showb #-}

-- | /Since: 3.6/
instance TextShow UniversalTime where
    showb :: UniversalTime -> Builder
showb UniversalTime
t = LocalTime -> Builder
forall a. TextShow a => a -> Builder
showb (LocalTime -> Builder) -> LocalTime -> Builder
forall a b. (a -> b) -> a -> b
$ Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
t
    {-# INLINE showb #-}

#if MIN_VERSION_time(1,5,0)
-- | Only available with @time-1.5@ or later.
--
-- /Since: 2/
$(deriveTextShow ''TimeLocale)
#endif

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