-- | convert  between 'UTCTime', 'UTCTimeBin', 'DatePart', 'DatePartSmall'
module Data.Time.Hora.Part
        (-- * FromUTC
        FromUTC(..),
        fromUtc',
        -- * ToUTC
        ToUTC(..),
        -- * 'DatePartSmall'
        mkDay,
        mkMin,
        mkMs,
        normalize,
        julian_day_offset
         ) where

import Data.Fixed
import Data.Ratio
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Hora.Internal.Span
import Data.Time.Hora.Span
import Data.Time.Hora.Type
import Data.Time.LocalTime as L
import Data.Word

class FromUTC a where
     fromUtc::UTCTime -> a

-- | returns DatePart a in UTC timezone
instance Integral a => FromUTC (DatePart a) where
   fromUtc::Integral a => UTCTime -> DatePart a
   fromUtc t0 =
       let day1 = utctDay t0::Day
           dt1 = utctDayTime t0::DiffTime
           (y1,m1,d1) = toGregorian day1
           (tod1, sec5, pico5) = todSecPico dt1
       in DatePart {
               year = fi y1,
               month = fi m1,
               day = fi d1,
               hour = fi $ todHour tod1,
               minute = fi $ todMin tod1,
               second = fi sec5,
               pico = fi pico5
               }


-- | extract (TimeIfDay, seconds, picoseconds) from 'DiffTime'
todSecPico::Integral a => DiffTime -> (TimeOfDay, a, Integer)
todSecPico dt0 = (tod1, sec5, pico5)
   where tod1 = timeToTimeOfDay dt0::TimeOfDay
         pico4 = todSec tod1::Fixed E12
         (sec5, MkFixed pico5) = properFraction pico4


diffTime::Int        -- ^ hour
        -> Int       -- ^ minute
        -> Fixed E12   -- ^ pico
        -> DiffTime
diffTime h0 m0 p0 = timeOfDayToTime tod1
      where tod1 = TimeOfDay h0 m0 p0


instance FromUTC UTCTimeBin where
      fromUtc::UTCTime -> UTCTimeBin
      fromUtc t0 = UTCTimeBin day1 pico1
            where day1 = toModifiedJulianDay $ utctDay t0
                  pico1 =  diffTimeToPicoseconds $ utctDayTime t0


instance FromUTC DatePartSmall where
      fromUtc::UTCTime -> DatePartSmall
      fromUtc t0 = DatePartSmall day2 minute2 milli2
            where dp1 = fromUtc t0::DatePart Int
                  UTCTimeBin julian1 _ = fromUtc t0::UTCTimeBin
                  day2 = fi julian1 + julian_day_offset
                  minute2 = fi $ hour dp1 * 60 + minute dp1
                  milli2 = fromSec3 + fromPico3
                  fromSec3 = toMilli (Sec $ second dp1)::Word32
                  fromPico3 = toMilli $ Pico $ pico dp1::Word32




{- | specified time zone

Tz (DatePart a)  parts show local date & time  

see also "Data.Time.Hora.Zone"  -}
fromUtc'::(Tz' tz, Integral a) =>
    tz -> UTCTime -> Tz (DatePart a)
fromUtc' tz0 utc0 =
    let tz1 = tz' tz0 utc0
        lt2 = L.utcToLocalTime tz1 utc0
        day2 = localDay lt2
        time2 = localTimeOfDay lt2
        (y3,m3,d3) = toGregorian day2
        d4 = DatePart{
                     year = fi y3,
                     month = fi m3,
                     day = fi d3,
                     hour = fi $ todHour time2,
                     minute = fi $ todMin time2,
                     second = fi sec5,
                     pico = fi pico5
                   }
        pico4 = todSec time2::Fixed E12
        (sec5, MkFixed pico5) = properFraction pico4
    in Tz tz1 d4


{-| convert 'DatePart' -> 'UTCTime'

Invalid date returns Nothing -}
class ToUTC a where
    toUtc::a -> Maybe UTCTime


instance Integral a => ToUTC (DatePart a) where
    toUtc dp0 =
        let h1 = hour dp0 * 60 * 60 --  as second 
            min1 = minute dp0 * 60  --  as second
            s2 = second dp0 + h1 + min1
            diff1 = secondsToDiffTime $ fi s2
            diff2 = picosecondsToDiffTime $ fi $ pico dp0

            mday1 = fromGregorianValid (fi $ year dp0)
                            (fi $ month dp0) $ fi $ day dp0
        in mday1 >>= \day1 -> Just $ UTCTime day1 $ diff1 + diff2
-- ^ assumes DatePart is UTC 


instance Integral a => ToUTC (Tz (DatePart a)) where
    toUtc (Tz tz0 dp0) =
        let s1 = toPico $ Sec $ second dp0
            mtod1 = makeTimeOfDayValid (fi $ hour dp0)
                                        (fi $ minute dp0)
                                        (timeSpanPico $ Pico s1 + (Pico $ fi $ pico dp0))
            mday1 = fromGregorianValid (fi $ year dp0)
                            (fi $ month dp0) $ fi $ day dp0
        in mday1 >>= \day1 ->
            mtod1 >>= \tod1 ->
                let lt1 = LocalTime day1 tod1
                    zt1 = ZonedTime lt1 tz0
                in Just $ zonedTimeToUTC zt1


instance ToUTC UTCTimeBin where
     toUtc (UTCTimeBin day0 pico0) = Just $ UTCTime day1 diff1
         where day1 = ModifiedJulianDay day0
               diff1 = picosecondsToDiffTime pico0


instance ToUTC DatePartSmall where
   toUtc dp0@(DatePartSmall _ _ _) = Just utc1
        where (DatePartSmall d0 m0 ms0) = normalize dp0
              utc1 = UTCTime day2 diff2
              day1 = fi d0 - julian_day_offset::Integer
              day2 = ModifiedJulianDay day1
              diff2 = diffTime hr1 min1 pico2
              min1 = fi $ m0 `rem` 60
              hr1 = fi $ m0 `div` 60
              sec1 = fi $ ms0 `div` 1000
              sec2 = MkFixed $ sec1 * picoSec::Fixed E12
              ms1 = fi ms0::Integer
              pico1 = fromRational $ (ms1 `rem` 1000) % 1000::Fixed E12
              pico2 = sec2 + pico1
   toUtc _ = Nothing


{- |  Julian day offset

https://en.wikipedia.org/wiki/Julian_day

>>> mkDay 1 1 1 `shouldBe` (Day 1)

>>> mkDay 1858 11 17 `shouldBe` (Day julian_day_offset)
-}
julian_day_offset::Integral a => a
julian_day_offset = fromIntegral 678576


-- | day / date
mkDay::Integral a =>
         a     -- ^ year
        -> a   -- ^ month
        -> a   -- ^ day
        -> DatePartSmall   -- ^ 'Day'
mkDay y0 m0 d0 = maybe (Error Invalid) id mday2
   where mday2 = valid2 <$> mday1::Maybe DatePartSmall
         mday1 = fromGregorianValid y1 m1 d1
         valid2 = Day . fromIntegral . (+ julian_day_offset) . toModifiedJulianDay
         y1 = fromIntegral y0
         m1 = fromIntegral m0
         d1 = fromIntegral d0


-- | minutes including hours
mkMin::(Num a, Integral a) =>
        a      -- ^ hour
        -> a   -- ^ minute
        -> DatePartSmall   -- ^ 'Min'
mkMin h0 m0 = Min $ fromIntegral $ h0 * 60 + m0


-- | milliseconds including seconds
mkMs::(Num a, Integral a) =>
        a      -- ^ second
        -> a   -- ^ millisecond
        -> DatePartSmall   -- ^ 'Ms'
mkMs s0 ms0 = Ms $ fromIntegral $ toMilli (Sec s0) + ms0


{- |  for ('Time', 'DatePartSmall') increase:

      minutes if seconds > 60

      days if minutes > 24 * 60

      ! does not change the constructor. 'Time' remains 'Time'

      this function is called by 'toUtc' before the conversion
-}
normalize::DatePartSmall -> DatePartSmall
normalize dp0
   | (Time m1 ms1) <- dp0,
         ms2::Int <- fi ms1,
         sec1 <- ts ms2,
         sec1 >= 60
            = let m3 = (sec1 `div` 60) + (fi m1::Int)
                  sec2 = sec1 `rem` 60
                  ms3 = (tm sec2) + ms2 - (tm sec1)
              in Time (fi m3) $ fi ms3

   | (DatePartSmall d1 m1 ms1) <- dp0,
         ms2::Int <- fi ms1,
         sec1 <- ts ms2,
         sec1 >= 60
            = let Time m2 ms2 = normalize $ Time m1 ms1
              in normalize $ DatePartSmall d1 m2 ms2

   | (DatePartSmall d1 m1 ms1) <- dp0,
         m2 <- fi m1::Int,
         hr1 <- m2 `div` 60,
         hr1 >= 24
            = let d2 = hr1 `div` 24 + (fi d1)
                  hr2 = hr1 `rem` 24
                  m3 = m2 `rem` 60 + hr2 * 60
              in DatePartSmall (fi d2) (fi m3) ms1

   | otherwise = dp0

tm::Integral a => a -> a
tm = toMilli . Sec

ts::Integral a => a -> a
ts = toSec . Milli