module Data.Astro.Time.JulianDate
(
JulianDate(..)
, julianStartDateTime
, LocalCivilTime(..)
, LocalCivilDate(..)
, TimeBaseType
, numberOfDays
, numberOfYears
, numberOfCenturies
, addHours
, fromYMD
, fromYMDHMS
, toYMDHMS
, dayOfWeek
, splitToDayAndTime
, lctFromYMDHMS
, lctToYMDHMS
, lcdFromYMD
, printLctHs
)
where
import Text.Printf (printf)
import Data.Astro.Types(DecimalHours(..), fromHMS, toHMS)
import Data.Astro.Time.GregorianCalendar (gregorianDateAdjustment)
import Data.Astro.Utils (trunc, fraction)
type TimeBaseType = Double
newtype JulianDate = JD TimeBaseType
deriving (Show, Eq)
data LocalCivilTime = LCT {
lctTimeZone :: DecimalHours
, lctUniversalTime :: JulianDate
} deriving (Eq)
instance Show LocalCivilTime where
show = printLct
data LocalCivilDate = LCD {
lcdTimeZone :: DecimalHours
, lcdDate :: JulianDate
} deriving (Eq)
julianStartDateTime = fromYMDHMS (-4712) 1 1 12 0 0
instance Num JulianDate where
(+) (JD d1) (JD d2) = JD (d1+d2)
(-) (JD d1) (JD d2) = JD (d1-d2)
(*) (JD d1) (JD d2) = JD (d1*d2)
negate (JD d) = JD (negate d)
abs (JD d) = JD (abs d)
signum (JD d) = JD (signum d)
fromInteger int = JD (fromInteger int)
numberOfDays :: JulianDate -> JulianDate -> TimeBaseType
numberOfDays (JD jd1) (JD jd2) = jd2 - jd1
numberOfYears :: JulianDate -> JulianDate -> TimeBaseType
numberOfYears (JD jd1) (JD jd2) = (jd2-jd1) / 365.25
numberOfCenturies :: JulianDate -> JulianDate -> TimeBaseType
numberOfCenturies (JD jd1) (JD jd2) = (jd2-jd1) / 36525
addHours :: DecimalHours -> JulianDate -> JulianDate
addHours (DH hours) jd = jd + (JD $ hours/24)
fromYMD :: Integer -> Int -> Int -> JulianDate
fromYMD year month day =
let (y, m) = if month < 3 then (year-1, month+12) else (year, month)
y' = fromIntegral y
m' = fromIntegral m
b = gregorianDateAdjustment year month day
c = if y < 0
then truncate (365.25*y' - 0.75)
else truncate (365.25*y')
d = truncate (30.6001 * (m'+1))
jd = fromIntegral (b + c + d + day) + 1720994.5
in JD jd
fromYMDHMS :: Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate
fromYMDHMS year month day hs ms ss = addHours (fromHMS hs ms ss) (fromYMD year month day)
toYMDHMS :: JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType)
toYMDHMS (JD jd) =
let (i, time) = fraction (jd + 0.5)
b = if i > 2299160
then let a = trunc $ (i-1867216.25)/36524.25
in i + a - trunc (a*0.25) + 1
else i
c = b + 1524
d = trunc $ (c-122.1)/365.25
e = trunc $ d * 365.25
g = trunc $ (c-e)/30.6001
day = truncate $ c - e - trunc (30.6001*g)
month = truncate $ if g < 13.5 then g - 1 else g - 13
year = truncate $ if month > 2 then d-4716 else d-4715
(h, m, s) = toHMS $ DH $ 24*time
in (year, month, day, h, m, s)
dayOfWeek :: JulianDate -> Int
dayOfWeek jd =
let JD d = removeHours jd
(_, f) = properFraction $ (d+1.5) / 7
in round (7*f)
splitToDayAndTime :: JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime jd@(JD n) =
let day = JD $ 0.5 + trunc (n - 0.5)
time = jd - day
in (day, time)
removeHours :: JulianDate -> JulianDate
removeHours jd =
let (d, _) = splitToDayAndTime jd
in d
lctFromYMDHMS :: DecimalHours ->Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> LocalCivilTime
lctFromYMDHMS tz y m d hs ms ss =
let jd = fromYMDHMS y m d hs ms ss
jd' = addHours (-tz) jd
in LCT tz jd'
lctToYMDHMS :: LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)
lctToYMDHMS (LCT tz jd)= toYMDHMS (addHours tz jd)
lcdFromYMD :: DecimalHours -> Integer -> Int -> Int -> LocalCivilDate
lcdFromYMD tz y m d = LCD tz (fromYMD y m d)
printLct :: LocalCivilTime -> String
printLct lct =
printf "%d-%02d-%02d %02d:%02d:%07.4f %+03.1f" y m d hs ms ss tz
where (y, m, d, hs, ms, ss) = lctToYMDHMS lct
DH tz = lctTimeZone lct
printLctHs :: LocalCivilTime -> String
printLctHs lct =
printf "lctFromYMDHMS (%1.0f) %d %d %d %d %d %.4f" tz y m d hs ms ss
where (y, m, d, hs, ms, ss) = lctToYMDHMS lct
DH tz = lctTimeZone lct