{-# 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 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
m forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' 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 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' 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 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'-' 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' 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 forall a. Ord a => a -> a -> Bool
>= Year
1000 = forall a. Integral a => a -> Builder
B.decimal Year
y
    | Year
y forall a. Ord a => a -> a -> Bool
>= Year
0    = forall a. Integral a => a -> Builder
padYear Year
y
    | Year
y forall a. Ord a => a -> a -> Bool
>= -Year
999 = Char -> Builder
char7 Char
'-' forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> Builder
padYear (forall a. Num a => a -> a
negate Year
y)
    | Bool
otherwise = forall a. Integral a => a -> Builder
B.decimal Year
y
  where
    padYear :: p -> Builder
padYear p
y' =
        let (Int
ab,Int
c) = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
y' forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
            (Int
a,Int
b)  = Int
ab forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
10
        in Char -> Builder
char7 Char
'0' forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
a forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
b 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 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' forall a. Semigroup a => a -> a -> a
<>
    Int -> Builder
digits2 Int
m forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' forall a. Semigroup a => a -> a -> a
<>
    Int -> Builder
digits2 (forall a. Num a => Year -> a
fromInteger Year
real) forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
buildFrac (forall a. Num a => Year -> a
fromInteger Year
frac)
  where
    (Year
real,Year
frac) = Year
s forall a. Integral a => a -> a -> (a, a)
`quotRem` Year
pico

    buildFrac :: Int64 -> Builder
    buildFrac :: Int64 -> Builder
buildFrac Int64
0 = forall a. Monoid a => a
mempty
    buildFrac Int64
i = Char -> Builder
char7 Char
'.' forall a. Semigroup a => a -> a -> a
<> case Int64
i 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 forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
buildFrac6 Int64
lo

    buildFrac6 :: Int64 -> Builder
    buildFrac6 :: Int64 -> Builder
buildFrac6 Int64
i = case Int64
i 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 forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digits3 Int64
lo

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

    digits3 :: Int64 -> Builder
digits3 Int64
i = Int64 -> Builder
digit64 Int64
a forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digit64 Int64
b forall a. Semigroup a => a -> a -> a
<> Int64 -> Builder
digit64 Int64
c
      where
        (Int64
ab, Int64
c) = Int64
i forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
10
        (Int64
a, Int64
b) = Int64
ab 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 forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
char7 Char
'Z'
    | Bool
otherwise = Char -> Builder
char7 Char
s forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
h forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digits2 Int
m
  where !s :: Char
s         = if Int
off forall a. Ord a => a -> a -> Bool
< Int
0 then Char
'-' else Char
'+'
        (Int
h,Int
m)      = forall a. Num a => a -> a
abs Int
off 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 forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'T' 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) 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 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 forall a. Semigroup a => a -> a -> a
<> Int -> Builder
digit Int
lo
  where (Int
hi,Int
lo) = Int
a 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 forall a. Num a => a -> a -> a
+ Int
48))

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

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