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 (Int -> JulianDate -> ShowS
[JulianDate] -> ShowS
JulianDate -> String
(Int -> JulianDate -> ShowS)
-> (JulianDate -> String)
-> ([JulianDate] -> ShowS)
-> Show JulianDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JulianDate] -> ShowS
$cshowList :: [JulianDate] -> ShowS
show :: JulianDate -> String
$cshow :: JulianDate -> String
showsPrec :: Int -> JulianDate -> ShowS
$cshowsPrec :: Int -> JulianDate -> ShowS
Show, JulianDate -> JulianDate -> Bool
(JulianDate -> JulianDate -> Bool)
-> (JulianDate -> JulianDate -> Bool) -> Eq JulianDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JulianDate -> JulianDate -> Bool
$c/= :: JulianDate -> JulianDate -> Bool
== :: JulianDate -> JulianDate -> Bool
$c== :: JulianDate -> JulianDate -> Bool
Eq)
data LocalCivilTime = LCT {
LocalCivilTime -> DecimalHours
lctTimeZone :: DecimalHours
, LocalCivilTime -> JulianDate
lctUniversalTime :: JulianDate
} deriving (LocalCivilTime -> LocalCivilTime -> Bool
(LocalCivilTime -> LocalCivilTime -> Bool)
-> (LocalCivilTime -> LocalCivilTime -> Bool) -> Eq LocalCivilTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCivilTime -> LocalCivilTime -> Bool
$c/= :: LocalCivilTime -> LocalCivilTime -> Bool
== :: LocalCivilTime -> LocalCivilTime -> Bool
$c== :: LocalCivilTime -> LocalCivilTime -> Bool
Eq)
instance Show LocalCivilTime where
show :: LocalCivilTime -> String
show = LocalCivilTime -> String
printLct
data LocalCivilDate = LCD {
LocalCivilDate -> DecimalHours
lcdTimeZone :: DecimalHours
, LocalCivilDate -> JulianDate
lcdDate :: JulianDate
} deriving (LocalCivilDate -> LocalCivilDate -> Bool
(LocalCivilDate -> LocalCivilDate -> Bool)
-> (LocalCivilDate -> LocalCivilDate -> Bool) -> Eq LocalCivilDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalCivilDate -> LocalCivilDate -> Bool
$c/= :: LocalCivilDate -> LocalCivilDate -> Bool
== :: LocalCivilDate -> LocalCivilDate -> Bool
$c== :: LocalCivilDate -> LocalCivilDate -> Bool
Eq)
julianStartDateTime :: JulianDate
julianStartDateTime = Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate
fromYMDHMS (-Integer
4712) Int
1 Int
1 Int
12 Int
0 TimeBaseType
0
instance Num JulianDate where
+ :: JulianDate -> JulianDate -> JulianDate
(+) (JD TimeBaseType
d1) (JD TimeBaseType
d2) = TimeBaseType -> JulianDate
JD (TimeBaseType
d1TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+TimeBaseType
d2)
(-) (JD TimeBaseType
d1) (JD TimeBaseType
d2) = TimeBaseType -> JulianDate
JD (TimeBaseType
d1TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
d2)
* :: JulianDate -> JulianDate -> JulianDate
(*) (JD TimeBaseType
d1) (JD TimeBaseType
d2) = TimeBaseType -> JulianDate
JD (TimeBaseType
d1TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
d2)
negate :: JulianDate -> JulianDate
negate (JD TimeBaseType
d) = TimeBaseType -> JulianDate
JD (TimeBaseType -> TimeBaseType
forall a. Num a => a -> a
negate TimeBaseType
d)
abs :: JulianDate -> JulianDate
abs (JD TimeBaseType
d) = TimeBaseType -> JulianDate
JD (TimeBaseType -> TimeBaseType
forall a. Num a => a -> a
abs TimeBaseType
d)
signum :: JulianDate -> JulianDate
signum (JD TimeBaseType
d) = TimeBaseType -> JulianDate
JD (TimeBaseType -> TimeBaseType
forall a. Num a => a -> a
signum TimeBaseType
d)
fromInteger :: Integer -> JulianDate
fromInteger Integer
int = TimeBaseType -> JulianDate
JD (Integer -> TimeBaseType
forall a. Num a => Integer -> a
fromInteger Integer
int)
numberOfDays :: JulianDate -> JulianDate -> TimeBaseType
numberOfDays :: JulianDate -> JulianDate -> TimeBaseType
numberOfDays (JD TimeBaseType
jd1) (JD TimeBaseType
jd2) = TimeBaseType
jd2 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
jd1
numberOfYears :: JulianDate -> JulianDate -> TimeBaseType
numberOfYears :: JulianDate -> JulianDate -> TimeBaseType
numberOfYears (JD TimeBaseType
jd1) (JD TimeBaseType
jd2) = (TimeBaseType
jd2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
jd1) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/ TimeBaseType
365.25
numberOfCenturies :: JulianDate -> JulianDate -> TimeBaseType
numberOfCenturies :: JulianDate -> JulianDate -> TimeBaseType
numberOfCenturies (JD TimeBaseType
jd1) (JD TimeBaseType
jd2) = (TimeBaseType
jd2TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
jd1) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/ TimeBaseType
36525
addHours :: DecimalHours -> JulianDate -> JulianDate
addHours :: DecimalHours -> JulianDate -> JulianDate
addHours (DH TimeBaseType
hours) JulianDate
jd = JulianDate
jd JulianDate -> JulianDate -> JulianDate
forall a. Num a => a -> a -> a
+ (TimeBaseType -> JulianDate
JD (TimeBaseType -> JulianDate) -> TimeBaseType -> JulianDate
forall a b. (a -> b) -> a -> b
$ TimeBaseType
hoursTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/TimeBaseType
24)
fromYMD :: Integer -> Int -> Int -> JulianDate
fromYMD :: Integer -> Int -> Int -> JulianDate
fromYMD Integer
year Int
month Int
day =
let (Integer
y, Int
m) = if Int
month Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 then (Integer
yearInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1, Int
monthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
12) else (Integer
year, Int
month)
y' :: TimeBaseType
y' = Integer -> TimeBaseType
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y
m' :: TimeBaseType
m' = Int -> TimeBaseType
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m
b :: Int
b = Integer -> Int -> Int -> Int
gregorianDateAdjustment Integer
year Int
month Int
day
c :: Int
c = if Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
then TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType
365.25TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
y' TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
0.75)
else TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType
365.25TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
y')
d :: Int
d = TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType
30.6001 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
* (TimeBaseType
m'TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+TimeBaseType
1))
jd :: TimeBaseType
jd = Int -> TimeBaseType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
1720994.5
in TimeBaseType -> JulianDate
JD TimeBaseType
jd
fromYMDHMS :: Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate
fromYMDHMS :: Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate
fromYMDHMS Integer
year Int
month Int
day Int
hs Int
ms TimeBaseType
ss = DecimalHours -> JulianDate -> JulianDate
addHours (Int -> Int -> TimeBaseType -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
hs Int
ms TimeBaseType
ss) (Integer -> Int -> Int -> JulianDate
fromYMD Integer
year Int
month Int
day)
toYMDHMS :: JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType)
toYMDHMS :: JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType)
toYMDHMS (JD TimeBaseType
jd) =
let (TimeBaseType
i, TimeBaseType
time) = TimeBaseType -> (TimeBaseType, TimeBaseType)
forall a b. (RealFrac a, Num b) => a -> (b, a)
fraction (TimeBaseType
jd TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
0.5)
b :: TimeBaseType
b = if TimeBaseType
i TimeBaseType -> TimeBaseType -> Bool
forall a. Ord a => a -> a -> Bool
> TimeBaseType
2299160
then let a :: TimeBaseType
a = TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ (TimeBaseType
iTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
1867216.25)TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/TimeBaseType
36524.25
in TimeBaseType
i TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
a TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType
aTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
0.25) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
1
else TimeBaseType
i
c :: TimeBaseType
c = TimeBaseType
b TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType
1524
d :: TimeBaseType
d = TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ (TimeBaseType
cTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
122.1)TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/TimeBaseType
365.25
e :: TimeBaseType
e = TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ TimeBaseType
d TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
* TimeBaseType
365.25
g :: TimeBaseType
g = TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType -> TimeBaseType) -> TimeBaseType -> TimeBaseType
forall a b. (a -> b) -> a -> b
$ (TimeBaseType
cTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
e)TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/TimeBaseType
30.6001
day :: Int
day = TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType -> Int) -> TimeBaseType -> Int
forall a b. (a -> b) -> a -> b
$ TimeBaseType
c TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
e TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType
30.6001TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
g)
month :: Int
month = TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType -> Int) -> TimeBaseType -> Int
forall a b. (a -> b) -> a -> b
$ if TimeBaseType
g TimeBaseType -> TimeBaseType -> Bool
forall a. Ord a => a -> a -> Bool
< TimeBaseType
13.5 then TimeBaseType
g TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
1 else TimeBaseType
g TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
13
year :: Integer
year = TimeBaseType -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (TimeBaseType -> Integer) -> TimeBaseType -> Integer
forall a b. (a -> b) -> a -> b
$ if Int
month Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then TimeBaseType
dTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
4716 else TimeBaseType
dTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
-TimeBaseType
4715
(Int
h, Int
m, TimeBaseType
s) = DecimalHours -> (Int, Int, TimeBaseType)
forall a b.
(Integral a, Integral b) =>
DecimalHours -> (a, b, TimeBaseType)
toHMS (DecimalHours -> (Int, Int, TimeBaseType))
-> DecimalHours -> (Int, Int, TimeBaseType)
forall a b. (a -> b) -> a -> b
$ TimeBaseType -> DecimalHours
DH (TimeBaseType -> DecimalHours) -> TimeBaseType -> DecimalHours
forall a b. (a -> b) -> a -> b
$ TimeBaseType
24TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
time
in (Integer
year, Int
month, Int
day, Int
h, Int
m, TimeBaseType
s)
dayOfWeek :: JulianDate -> Int
dayOfWeek :: JulianDate -> Int
dayOfWeek JulianDate
jd =
let JD TimeBaseType
d = JulianDate -> JulianDate
removeHours JulianDate
jd
(Integer
_, TimeBaseType
f) = TimeBaseType -> (Integer, TimeBaseType)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (TimeBaseType -> (Integer, TimeBaseType))
-> TimeBaseType -> (Integer, TimeBaseType)
forall a b. (a -> b) -> a -> b
$ (TimeBaseType
dTimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+TimeBaseType
1.5) TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Fractional a => a -> a -> a
/ TimeBaseType
7
in TimeBaseType -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (TimeBaseType
7TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
*TimeBaseType
f)
splitToDayAndTime :: JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime :: JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime jd :: JulianDate
jd@(JD TimeBaseType
n) =
let day :: JulianDate
day = TimeBaseType -> JulianDate
JD (TimeBaseType -> JulianDate) -> TimeBaseType -> JulianDate
forall a b. (a -> b) -> a -> b
$ TimeBaseType
0.5 TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
+ TimeBaseType -> TimeBaseType
forall a. RealFrac a => a -> a
trunc (TimeBaseType
n TimeBaseType -> TimeBaseType -> TimeBaseType
forall a. Num a => a -> a -> a
- TimeBaseType
0.5)
time :: JulianDate
time = JulianDate
jd JulianDate -> JulianDate -> JulianDate
forall a. Num a => a -> a -> a
- JulianDate
day
in (JulianDate
day, JulianDate
time)
removeHours :: JulianDate -> JulianDate
removeHours :: JulianDate -> JulianDate
removeHours JulianDate
jd =
let (JulianDate
d, JulianDate
_) = JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime JulianDate
jd
in JulianDate
d
lctFromYMDHMS :: DecimalHours ->Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> LocalCivilTime
lctFromYMDHMS :: DecimalHours
-> Integer
-> Int
-> Int
-> Int
-> Int
-> TimeBaseType
-> LocalCivilTime
lctFromYMDHMS DecimalHours
tz Integer
y Int
m Int
d Int
hs Int
ms TimeBaseType
ss =
let jd :: JulianDate
jd = Integer -> Int -> Int -> Int -> Int -> TimeBaseType -> JulianDate
fromYMDHMS Integer
y Int
m Int
d Int
hs Int
ms TimeBaseType
ss
jd' :: JulianDate
jd' = DecimalHours -> JulianDate -> JulianDate
addHours (-DecimalHours
tz) JulianDate
jd
in DecimalHours -> JulianDate -> LocalCivilTime
LCT DecimalHours
tz JulianDate
jd'
lctToYMDHMS :: LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)
lctToYMDHMS :: LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)
lctToYMDHMS (LCT DecimalHours
tz JulianDate
jd)= JulianDate -> (Integer, Int, Int, Int, Int, TimeBaseType)
toYMDHMS (DecimalHours -> JulianDate -> JulianDate
addHours DecimalHours
tz JulianDate
jd)
lcdFromYMD :: DecimalHours -> Integer -> Int -> Int -> LocalCivilDate
lcdFromYMD :: DecimalHours -> Integer -> Int -> Int -> LocalCivilDate
lcdFromYMD DecimalHours
tz Integer
y Int
m Int
d = DecimalHours -> JulianDate -> LocalCivilDate
LCD DecimalHours
tz (Integer -> Int -> Int -> JulianDate
fromYMD Integer
y Int
m Int
d)
printLct :: LocalCivilTime -> String
printLct :: LocalCivilTime -> String
printLct LocalCivilTime
lct =
String
-> Integer
-> Int
-> Int
-> Int
-> Int
-> TimeBaseType
-> TimeBaseType
-> String
forall r. PrintfType r => String -> r
printf String
"%d-%02d-%02d %02d:%02d:%07.4f %+03.1f" Integer
y Int
m Int
d Int
hs Int
ms TimeBaseType
ss TimeBaseType
tz
where (Integer
y, Int
m, Int
d, Int
hs, Int
ms, TimeBaseType
ss) = LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)
lctToYMDHMS LocalCivilTime
lct
DH TimeBaseType
tz = LocalCivilTime -> DecimalHours
lctTimeZone LocalCivilTime
lct
printLctHs :: LocalCivilTime -> String
printLctHs :: LocalCivilTime -> String
printLctHs LocalCivilTime
lct =
String
-> TimeBaseType
-> Integer
-> Int
-> Int
-> Int
-> Int
-> TimeBaseType
-> String
forall r. PrintfType r => String -> r
printf String
"lctFromYMDHMS (%1.0f) %d %d %d %d %d %.4f" TimeBaseType
tz Integer
y Int
m Int
d Int
hs Int
ms TimeBaseType
ss
where (Integer
y, Int
m, Int
d, Int
hs, Int
ms, TimeBaseType
ss) = LocalCivilTime -> (Integer, Int, Int, Int, Int, TimeBaseType)
lctToYMDHMS LocalCivilTime
lct
DH TimeBaseType
tz = LocalCivilTime -> DecimalHours
lctTimeZone LocalCivilTime
lct