{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
#if MIN_VERSION_time(1,5,0)
{-# LANGUAGE TemplateHaskell #-}
#endif
{-# OPTIONS_GHC -fno-warn-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.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 (Just c) b = singleton c <> b
pad1 _ b = b
{-# INLINE pad1 #-}
padN :: Int -> Char -> Builder -> Builder
padN i _ b | i <= 0 = b
padN i c b = mtimesDefault i (singleton c) <> b
{-# INLINE padN #-}
showb2 :: (Num t, Ord t, TextShow t) => NumericPadOption -> t -> Builder
showb2 = showbPaddedMin 2
{-# INLINE showb2 #-}
showb2Fixed :: NumericPadOption -> Pico -> Builder
showb2Fixed opt x | x < 10 = pad1 opt $ showbFixed True x
showb2Fixed _ x = showbFixed True x
{-# INLINE showb2Fixed #-}
showb4 :: (Num t, Ord t, TextShow t) => NumericPadOption -> t -> Builder
showb4 = showbPaddedMin 4
{-# INLINE showb4 #-}
showbGregorian :: Day -> Builder
showbGregorian date = showb4 zeroOpt y
<> singleton '-'
<> showb2 zeroOpt m
<> singleton '-'
<> showb2 zeroOpt d
where
(y,m,d) = toGregorian date
showbPaddedMin :: (Num t, Ord t, TextShow t) => Int -> NumericPadOption -> t -> Builder
showbPaddedMin _ Nothing i = showb i
showbPaddedMin pl opt i | i < 0 = singleton '-' <> showbPaddedMin pl opt (negate i)
showbPaddedMin pl (Just c) i =
let b = showb i
in padN (pl - fromIntegral (lengthB b)) c b
showbT :: NumericPadOption -> Int -> Builder
showbT opt t = showb4 opt ((div t 60) * 100 + (mod t 60))
{-# INLINE showbT #-}
timeZoneOffsetBuilder' :: NumericPadOption -> TimeZone -> Builder
timeZoneOffsetBuilder' opt (TimeZone t _ _) | t < 0 = singleton '-' <> showbT opt (negate t)
timeZoneOffsetBuilder' opt (TimeZone t _ _) = singleton '+' <> showbT opt t
{-# INLINE timeZoneOffsetBuilder' #-}
timeZoneOffsetBuilder :: TimeZone -> Builder
timeZoneOffsetBuilder = timeZoneOffsetBuilder' $ Just '0'
{-# INLINE timeZoneOffsetBuilder #-}
zeroOpt :: NumericPadOption
zeroOpt = Just '0'
{-# INLINE zeroOpt #-}
instance TextShow Day where
showb = showbGregorian
{-# INLINE showb #-}
instance TextShow DiffTime where
showb = showb . FromStringShow
{-# INLINE showb #-}
instance TextShow UTCTime where
showb = showb . utcToZonedTime utc
{-# INLINE showb #-}
instance TextShow NominalDiffTime where
showb = showb . FromStringShow
{-# INLINE showb #-}
instance TextShow AbsoluteTime where
showb t = showb (utcToLocalTime utc $
#if MIN_VERSION_time(1,7,0)
fromJust $ taiToUTCTime (const (Just 0)) t)
#else
taiToUTCTime (const 0) t)
#endif
<> " TAI"
{-# INLINE showb #-}
instance TextShow TimeZone where
showb zone@(TimeZone _ _ "") = timeZoneOffsetBuilder zone
showb (TimeZone _ _ name) = fromString name
{-# INLINE showb #-}
instance TextShow TimeOfDay where
showb (TimeOfDay h m sec) = showb2 zeroOpt h
<> singleton ':'
<> showb2 zeroOpt m
<> singleton ':'
<> showb2Fixed zeroOpt sec
{-# INLINE showb #-}
instance TextShow LocalTime where
showb (LocalTime d t) = showbGregorian d <> showbSpace <> showb t
{-# INLINE showb #-}
instance TextShow ZonedTime where
showb (ZonedTime t zone) = showb t <> showbSpace <> showb zone
{-# INLINE showb #-}
instance TextShow UniversalTime where
showb t = showb $ ut1ToLocalTime 0 t
{-# INLINE showb #-}
#if MIN_VERSION_time(1,5,0)
$(deriveTextShow ''TimeLocale)
#endif
#if MIN_VERSION_time(1,8,0)
$(deriveTextShow ''SystemTime)
#endif