{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP          #-}
module Data.Time.ToText (
    buildDay,
    buildLocalTime,
    buildTimeOfDay,
    buildTimeZone,
    buildUTCTime,
    buildZonedTime,
    buildYear,
    buildMonth,
    buildQuarter,
    buildQuarterOfYear,
) where

import           Data.Char                         (chr)
import           Data.Fixed                        (Fixed (..))
import           Data.Int                          (Int64)
import           Data.Text.Lazy.Builder            (Builder)

import           Data.Time                         (TimeOfDay (..))
import           Data.Time.Calendar                (Day, toGregorian)
import           Data.Time.Calendar.Compat         (Year)
import           Data.Time.Calendar.Month.Compat   (Month, toYearMonth)
import           Data.Time.Calendar.Quarter.Compat (Quarter, QuarterOfYear (..),
                                                    toYearQuarter)
import           Data.Time.Clock                   (UTCTime (..))

import qualified Data.Text.Lazy.Builder            as B
import qualified Data.Text.Lazy.Builder.Int        as B (decimal)
import qualified Data.Time.LocalTime               as Local

#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup                    ((<>))
#endif

buildDay :: Day -> Builder
buildDay :: Day -> Builder
buildDay Day
dd = Year -> Builder
buildYear Year
yr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
d
  where (Year
yr,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
dd
{-# INLINE buildDay #-}

buildMonth :: Month -> Builder
buildMonth :: Month -> Builder
buildMonth Month
mm = Year -> Builder
buildYear Year
yr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
m
  where (Year
yr,Int
m) = Month -> (Year, Int)
toYearMonth Month
mm
{-# INLINE buildMonth #-}

buildQuarter :: Quarter -> Builder
buildQuarter :: Quarter -> Builder
buildQuarter Quarter
qq = Year -> Builder
buildYear Year
yr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> QuarterOfYear -> Builder
buildQuarterOfYear QuarterOfYear
q
  where (Year
yr,QuarterOfYear
q) = Quarter -> (Year, QuarterOfYear)
toYearQuarter Quarter
qq
{-# INLINE buildQuarter #-}

buildQuarterOfYear :: QuarterOfYear -> Builder
buildQuarterOfYear :: QuarterOfYear -> Builder
buildQuarterOfYear QuarterOfYear
q = Char -> Builder
char7 Char
'q' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case QuarterOfYear
q of
    QuarterOfYear
Q1 -> Char -> Builder
char7 Char
'1'
    QuarterOfYear
Q2 -> Char -> Builder
char7 Char
'2'
    QuarterOfYear
Q3 -> Char -> Builder
char7 Char
'3'
    QuarterOfYear
Q4 -> Char -> Builder
char7 Char
'4'

-- | Used in encoding day, month, quarter
buildYear :: Year -> Builder
buildYear :: Year -> Builder
buildYear Year
y
    | Year
y Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
>= Year
1000 = Year -> Builder
forall a. Integral a => a -> Builder
B.decimal Year
y
    | Year
y Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
>= Year
0    = Year -> Builder
forall a. Integral a => a -> Builder
padYear Year
y
    | Year
y Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
>= -Year
999 = Char -> Builder
char7 Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Year -> Builder
forall a. Integral a => a -> Builder
padYear (Year -> Year
forall a. Num a => a -> a
negate Year
y)
    | Bool
otherwise = Year -> Builder
forall a. Integral a => a -> Builder
B.decimal Year
y
  where
    padYear :: p -> Builder
padYear p
y' =
        let (Int
ab,Int
c) = p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
y' Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
            (Int
a,Int
b)  = Int
ab Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        in Char -> Builder
char7 Char
'0' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
c
{-# INLINE buildYear #-}

buildTimeOfDay :: TimeOfDay -> Builder
buildTimeOfDay :: TimeOfDay -> Builder
buildTimeOfDay (TimeOfDay Int
h Int
m (MkFixed Year
s)) =
    Int -> Builder
digits2 Int
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Builder
digits2 Int
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Builder
digits2 (Year -> Int
forall a. Num a => Year -> a
fromInteger Year
real) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
buildFrac (Year -> Int64
forall a. Num a => Year -> a
fromInteger Year
frac)
  where
    (Year
real,Year
frac) = Year
s Year -> Year -> (Year, Year)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Year
pico

    buildFrac :: Int64 -> Builder
    buildFrac :: Int64 -> Builder
buildFrac Int64
0 = Builder
forall a. Monoid a => a
mempty
    buildFrac Int64
i = Char -> Builder
char7 Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Int64
i Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
micro of
        (Int64
hi, Int64
0)  -> Int64 -> Builder
buildFrac6 Int64
hi
        (Int64
hi, Int64
lo) -> Int64 -> Builder
digits6 Int64
hi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
buildFrac6 Int64
lo

    buildFrac6 :: Int64 -> Builder
    buildFrac6 :: Int64 -> Builder
buildFrac6 Int64
i = case Int64
i Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
milli of
        (Int64
hi, Int64
0)  -> Int64 -> Builder
digits3 Int64
hi
        (Int64
hi, Int64
lo) -> Int64 -> Builder
digits3 Int64
hi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digits3 Int64
lo

    digits6 :: Int64 -> Builder
digits6 Int64
i = case Int64
i Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
milli of
        (Int64
hi, Int64
lo) -> Int64 -> Builder
digits3 Int64
hi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digits3 Int64
lo

    digits3 :: Int64 -> Builder
digits3 Int64
i = Int64 -> Builder
digit64 Int64
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digit64 Int64
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digit64 Int64
c
      where
        (Int64
ab, Int64
c) = Int64
i Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
10
        (Int64
a, Int64
b) = Int64
ab Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
10

    pico :: Year
pico       = Year
1000000000000 -- number of picoseconds  in 1 second
    micro :: Int64
micro      =       Int64
1000000 -- number of microseconds in 1 second
    milli :: Int64
milli      =          Int64
1000 -- number of milliseconds in 1 second
{-# INLINE buildTimeOfDay #-}

buildTimeZone :: Local.TimeZone -> Builder
buildTimeZone :: TimeZone -> Builder
buildTimeZone (Local.TimeZone Int
off Bool
_ String
_)
    | Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
char7 Char
'Z'
    | Bool
otherwise = Char -> Builder
char7 Char
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
h Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
m
  where !s :: Char
s         = if Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Char
'-' else Char
'+'
        (Int
h,Int
m)      = Int -> Int
forall a. Num a => a -> a
abs Int
off Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
60
{-# INLINE buildTimeZone #-}

dayTime :: Day -> TimeOfDay -> Builder
dayTime :: Day -> TimeOfDay -> Builder
dayTime Day
d TimeOfDay
t = Day -> Builder
buildDay Day
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'T' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeOfDay -> Builder
buildTimeOfDay TimeOfDay
t
{-# INLINE dayTime #-}

buildUTCTime :: UTCTime -> B.Builder
buildUTCTime :: UTCTime -> Builder
buildUTCTime (UTCTime Day
d DiffTime
s) = Day -> TimeOfDay -> Builder
dayTime Day
d (DiffTime -> TimeOfDay
Local.timeToTimeOfDay DiffTime
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'Z'
{-# INLINE buildUTCTime #-}

buildLocalTime :: Local.LocalTime -> Builder
buildLocalTime :: LocalTime -> Builder
buildLocalTime (Local.LocalTime Day
d TimeOfDay
t) = Day -> TimeOfDay -> Builder
dayTime Day
d TimeOfDay
t
{-# INLINE buildLocalTime #-}

buildZonedTime :: Local.ZonedTime -> Builder
buildZonedTime :: ZonedTime -> Builder
buildZonedTime (Local.ZonedTime LocalTime
t TimeZone
z) = LocalTime -> Builder
buildLocalTime LocalTime
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
buildTimeZone TimeZone
z
{-# INLINE buildZonedTime #-}

-------------------------------------------------------------------------------
-- Utilities
-------------------------------------------------------------------------------

digits2 :: Int -> Builder
digits2 :: Int -> Builder
digits2 Int
a     = Int -> Builder
digit Int
hi Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
lo
  where (Int
hi,Int
lo) = Int
a Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10

digit :: Int -> Builder
digit :: Int -> Builder
digit Int
x = Char -> Builder
char7 (Int -> Char
chr (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48))

digit64 :: Int64 -> Builder
digit64 :: Int64 -> Builder
digit64 = Int -> Builder
digit (Int -> Builder) -> (Int64 -> Int) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

char7 :: Char -> Builder
char7 :: Char -> Builder
char7 = Char -> Builder
B.singleton