{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GADTs #-}
module SwissEphemeris.Time
(
TimeStandard (..),
JulianDay,
JulianDayUT,
JulianDayTT,
JulianDayUT1,
getJulianDay,
SiderealTime,
getSiderealTime,
SingTimeStandard(..),
SingTSI(..),
ToJulianDay (..),
FromJulianDay (..),
ConversionResult,
getConversionResult,
mkJulianDay,
coerceUT,
julianNoon,
julianMidnight,
utcToJulianDays,
dayFromJulianDay,
dayToJulianDay,
gregorianToFakeJulianDayTT,
gregorianFromFakeJulianDayTT,
gregorianToJulianDayUT,
gregorianFromJulianDayUT,
utcToJulianDayUT,
julianDayUTToUTC,
utcToJulian,
julianToUTC,
addDeltaTime,
subtractDeltaTime,
unsafeDeltaTime,
deltaTime,
safeDeltaTime,
deltaTimeSE,
universalToTerrestrial,
universalToTerrestrialSafe,
universalToTerrestrialSE,
julianToSiderealSimple,
julianToSidereal
)
where
import qualified Control.Monad.Fail as Fail
import Data.Time
import Foreign
import Foreign.C.String
import Foreign.SwissEphemeris
import SwissEphemeris.Internal
import System.IO.Unsafe (unsafePerformIO)
import Data.Kind (Type)
data TimeStandard
=
TT
|
UT1
|
UT
deriving (TimeStandard -> TimeStandard -> Bool
(TimeStandard -> TimeStandard -> Bool)
-> (TimeStandard -> TimeStandard -> Bool) -> Eq TimeStandard
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeStandard -> TimeStandard -> Bool
$c/= :: TimeStandard -> TimeStandard -> Bool
== :: TimeStandard -> TimeStandard -> Bool
$c== :: TimeStandard -> TimeStandard -> Bool
Eq, Int -> TimeStandard -> ShowS
[TimeStandard] -> ShowS
TimeStandard -> String
(Int -> TimeStandard -> ShowS)
-> (TimeStandard -> String)
-> ([TimeStandard] -> ShowS)
-> Show TimeStandard
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeStandard] -> ShowS
$cshowList :: [TimeStandard] -> ShowS
show :: TimeStandard -> String
$cshow :: TimeStandard -> String
showsPrec :: Int -> TimeStandard -> ShowS
$cshowsPrec :: Int -> TimeStandard -> ShowS
Show)
data SingTimeStandard :: TimeStandard -> Type where
STT :: SingTimeStandard 'TT
SUT1 :: SingTimeStandard 'UT1
SUT :: SingTimeStandard 'UT
class SingTSI a where
singTS :: SingTimeStandard a
instance SingTSI 'TT where
singTS :: SingTimeStandard 'TT
singTS = SingTimeStandard 'TT
STT
instance SingTSI 'UT1 where
singTS :: SingTimeStandard 'UT1
singTS = SingTimeStandard 'UT1
SUT1
instance SingTSI 'UT where
singTS :: SingTimeStandard 'UT
singTS = SingTimeStandard 'UT
SUT
newtype JulianDay (s :: TimeStandard) = MkJulianDay {
JulianDay s -> Double
getJulianDay :: Double}
deriving (JulianDay s -> JulianDay s -> Bool
(JulianDay s -> JulianDay s -> Bool)
-> (JulianDay s -> JulianDay s -> Bool) -> Eq (JulianDay s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
/= :: JulianDay s -> JulianDay s -> Bool
$c/= :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
== :: JulianDay s -> JulianDay s -> Bool
$c== :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
Eq, Int -> JulianDay s -> ShowS
[JulianDay s] -> ShowS
JulianDay s -> String
(Int -> JulianDay s -> ShowS)
-> (JulianDay s -> String)
-> ([JulianDay s] -> ShowS)
-> Show (JulianDay s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: TimeStandard). Int -> JulianDay s -> ShowS
forall (s :: TimeStandard). [JulianDay s] -> ShowS
forall (s :: TimeStandard). JulianDay s -> String
showList :: [JulianDay s] -> ShowS
$cshowList :: forall (s :: TimeStandard). [JulianDay s] -> ShowS
show :: JulianDay s -> String
$cshow :: forall (s :: TimeStandard). JulianDay s -> String
showsPrec :: Int -> JulianDay s -> ShowS
$cshowsPrec :: forall (s :: TimeStandard). Int -> JulianDay s -> ShowS
Show, Int -> JulianDay s
JulianDay s -> Int
JulianDay s -> [JulianDay s]
JulianDay s -> JulianDay s
JulianDay s -> JulianDay s -> [JulianDay s]
JulianDay s -> JulianDay s -> JulianDay s -> [JulianDay s]
(JulianDay s -> JulianDay s)
-> (JulianDay s -> JulianDay s)
-> (Int -> JulianDay s)
-> (JulianDay s -> Int)
-> (JulianDay s -> [JulianDay s])
-> (JulianDay s -> JulianDay s -> [JulianDay s])
-> (JulianDay s -> JulianDay s -> [JulianDay s])
-> (JulianDay s -> JulianDay s -> JulianDay s -> [JulianDay s])
-> Enum (JulianDay s)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall (s :: TimeStandard). Int -> JulianDay s
forall (s :: TimeStandard). JulianDay s -> Int
forall (s :: TimeStandard). JulianDay s -> [JulianDay s]
forall (s :: TimeStandard). JulianDay s -> JulianDay s
forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> [JulianDay s]
forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> JulianDay s -> [JulianDay s]
enumFromThenTo :: JulianDay s -> JulianDay s -> JulianDay s -> [JulianDay s]
$cenumFromThenTo :: forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> JulianDay s -> [JulianDay s]
enumFromTo :: JulianDay s -> JulianDay s -> [JulianDay s]
$cenumFromTo :: forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> [JulianDay s]
enumFromThen :: JulianDay s -> JulianDay s -> [JulianDay s]
$cenumFromThen :: forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> [JulianDay s]
enumFrom :: JulianDay s -> [JulianDay s]
$cenumFrom :: forall (s :: TimeStandard). JulianDay s -> [JulianDay s]
fromEnum :: JulianDay s -> Int
$cfromEnum :: forall (s :: TimeStandard). JulianDay s -> Int
toEnum :: Int -> JulianDay s
$ctoEnum :: forall (s :: TimeStandard). Int -> JulianDay s
pred :: JulianDay s -> JulianDay s
$cpred :: forall (s :: TimeStandard). JulianDay s -> JulianDay s
succ :: JulianDay s -> JulianDay s
$csucc :: forall (s :: TimeStandard). JulianDay s -> JulianDay s
Enum, Eq (JulianDay s)
Eq (JulianDay s)
-> (JulianDay s -> JulianDay s -> Ordering)
-> (JulianDay s -> JulianDay s -> Bool)
-> (JulianDay s -> JulianDay s -> Bool)
-> (JulianDay s -> JulianDay s -> Bool)
-> (JulianDay s -> JulianDay s -> Bool)
-> (JulianDay s -> JulianDay s -> JulianDay s)
-> (JulianDay s -> JulianDay s -> JulianDay s)
-> Ord (JulianDay s)
JulianDay s -> JulianDay s -> Bool
JulianDay s -> JulianDay s -> Ordering
JulianDay s -> JulianDay s -> JulianDay s
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (s :: TimeStandard). Eq (JulianDay s)
forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Ordering
forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> JulianDay s
min :: JulianDay s -> JulianDay s -> JulianDay s
$cmin :: forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> JulianDay s
max :: JulianDay s -> JulianDay s -> JulianDay s
$cmax :: forall (s :: TimeStandard).
JulianDay s -> JulianDay s -> JulianDay s
>= :: JulianDay s -> JulianDay s -> Bool
$c>= :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
> :: JulianDay s -> JulianDay s -> Bool
$c> :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
<= :: JulianDay s -> JulianDay s -> Bool
$c<= :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
< :: JulianDay s -> JulianDay s -> Bool
$c< :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Bool
compare :: JulianDay s -> JulianDay s -> Ordering
$ccompare :: forall (s :: TimeStandard). JulianDay s -> JulianDay s -> Ordering
$cp1Ord :: forall (s :: TimeStandard). Eq (JulianDay s)
Ord)
type JulianDayTT = JulianDay 'TT
type JulianDayUT = JulianDay 'UT
type JulianDayUT1 = JulianDay 'UT1
newtype SiderealTime = SiderealTime {SiderealTime -> Double
getSiderealTime:: Double}
deriving (Int -> SiderealTime -> ShowS
[SiderealTime] -> ShowS
SiderealTime -> String
(Int -> SiderealTime -> ShowS)
-> (SiderealTime -> String)
-> ([SiderealTime] -> ShowS)
-> Show SiderealTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SiderealTime] -> ShowS
$cshowList :: [SiderealTime] -> ShowS
show :: SiderealTime -> String
$cshow :: SiderealTime -> String
showsPrec :: Int -> SiderealTime -> ShowS
$cshowsPrec :: Int -> SiderealTime -> ShowS
Show, SiderealTime -> SiderealTime -> Bool
(SiderealTime -> SiderealTime -> Bool)
-> (SiderealTime -> SiderealTime -> Bool) -> Eq SiderealTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SiderealTime -> SiderealTime -> Bool
$c/= :: SiderealTime -> SiderealTime -> Bool
== :: SiderealTime -> SiderealTime -> Bool
$c== :: SiderealTime -> SiderealTime -> Bool
Eq, Eq SiderealTime
Eq SiderealTime
-> (SiderealTime -> SiderealTime -> Ordering)
-> (SiderealTime -> SiderealTime -> Bool)
-> (SiderealTime -> SiderealTime -> Bool)
-> (SiderealTime -> SiderealTime -> Bool)
-> (SiderealTime -> SiderealTime -> Bool)
-> (SiderealTime -> SiderealTime -> SiderealTime)
-> (SiderealTime -> SiderealTime -> SiderealTime)
-> Ord SiderealTime
SiderealTime -> SiderealTime -> Bool
SiderealTime -> SiderealTime -> Ordering
SiderealTime -> SiderealTime -> SiderealTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SiderealTime -> SiderealTime -> SiderealTime
$cmin :: SiderealTime -> SiderealTime -> SiderealTime
max :: SiderealTime -> SiderealTime -> SiderealTime
$cmax :: SiderealTime -> SiderealTime -> SiderealTime
>= :: SiderealTime -> SiderealTime -> Bool
$c>= :: SiderealTime -> SiderealTime -> Bool
> :: SiderealTime -> SiderealTime -> Bool
$c> :: SiderealTime -> SiderealTime -> Bool
<= :: SiderealTime -> SiderealTime -> Bool
$c<= :: SiderealTime -> SiderealTime -> Bool
< :: SiderealTime -> SiderealTime -> Bool
$c< :: SiderealTime -> SiderealTime -> Bool
compare :: SiderealTime -> SiderealTime -> Ordering
$ccompare :: SiderealTime -> SiderealTime -> Ordering
$cp1Ord :: Eq SiderealTime
Ord)
newtype ConversionResult dt = ConversionResult {ConversionResult dt -> Either String dt
getConversionResult :: Either String dt}
deriving (Int -> ConversionResult dt -> ShowS
[ConversionResult dt] -> ShowS
ConversionResult dt -> String
(Int -> ConversionResult dt -> ShowS)
-> (ConversionResult dt -> String)
-> ([ConversionResult dt] -> ShowS)
-> Show (ConversionResult dt)
forall dt. Show dt => Int -> ConversionResult dt -> ShowS
forall dt. Show dt => [ConversionResult dt] -> ShowS
forall dt. Show dt => ConversionResult dt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversionResult dt] -> ShowS
$cshowList :: forall dt. Show dt => [ConversionResult dt] -> ShowS
show :: ConversionResult dt -> String
$cshow :: forall dt. Show dt => ConversionResult dt -> String
showsPrec :: Int -> ConversionResult dt -> ShowS
$cshowsPrec :: forall dt. Show dt => Int -> ConversionResult dt -> ShowS
Show, a -> ConversionResult b -> ConversionResult a
(a -> b) -> ConversionResult a -> ConversionResult b
(forall a b. (a -> b) -> ConversionResult a -> ConversionResult b)
-> (forall a b. a -> ConversionResult b -> ConversionResult a)
-> Functor ConversionResult
forall a b. a -> ConversionResult b -> ConversionResult a
forall a b. (a -> b) -> ConversionResult a -> ConversionResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ConversionResult b -> ConversionResult a
$c<$ :: forall a b. a -> ConversionResult b -> ConversionResult a
fmap :: (a -> b) -> ConversionResult a -> ConversionResult b
$cfmap :: forall a b. (a -> b) -> ConversionResult a -> ConversionResult b
Functor, Functor ConversionResult
a -> ConversionResult a
Functor ConversionResult
-> (forall a. a -> ConversionResult a)
-> (forall a b.
ConversionResult (a -> b)
-> ConversionResult a -> ConversionResult b)
-> (forall a b c.
(a -> b -> c)
-> ConversionResult a -> ConversionResult b -> ConversionResult c)
-> (forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b)
-> (forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult a)
-> Applicative ConversionResult
ConversionResult a -> ConversionResult b -> ConversionResult b
ConversionResult a -> ConversionResult b -> ConversionResult a
ConversionResult (a -> b)
-> ConversionResult a -> ConversionResult b
(a -> b -> c)
-> ConversionResult a -> ConversionResult b -> ConversionResult c
forall a. a -> ConversionResult a
forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult a
forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b
forall a b.
ConversionResult (a -> b)
-> ConversionResult a -> ConversionResult b
forall a b c.
(a -> b -> c)
-> ConversionResult a -> ConversionResult b -> ConversionResult c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ConversionResult a -> ConversionResult b -> ConversionResult a
$c<* :: forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult a
*> :: ConversionResult a -> ConversionResult b -> ConversionResult b
$c*> :: forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b
liftA2 :: (a -> b -> c)
-> ConversionResult a -> ConversionResult b -> ConversionResult c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ConversionResult a -> ConversionResult b -> ConversionResult c
<*> :: ConversionResult (a -> b)
-> ConversionResult a -> ConversionResult b
$c<*> :: forall a b.
ConversionResult (a -> b)
-> ConversionResult a -> ConversionResult b
pure :: a -> ConversionResult a
$cpure :: forall a. a -> ConversionResult a
$cp1Applicative :: Functor ConversionResult
Applicative, Applicative ConversionResult
a -> ConversionResult a
Applicative ConversionResult
-> (forall a b.
ConversionResult a
-> (a -> ConversionResult b) -> ConversionResult b)
-> (forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b)
-> (forall a. a -> ConversionResult a)
-> Monad ConversionResult
ConversionResult a
-> (a -> ConversionResult b) -> ConversionResult b
ConversionResult a -> ConversionResult b -> ConversionResult b
forall a. a -> ConversionResult a
forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b
forall a b.
ConversionResult a
-> (a -> ConversionResult b) -> ConversionResult b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ConversionResult a
$creturn :: forall a. a -> ConversionResult a
>> :: ConversionResult a -> ConversionResult b -> ConversionResult b
$c>> :: forall a b.
ConversionResult a -> ConversionResult b -> ConversionResult b
>>= :: ConversionResult a
-> (a -> ConversionResult b) -> ConversionResult b
$c>>= :: forall a b.
ConversionResult a
-> (a -> ConversionResult b) -> ConversionResult b
$cp1Monad :: Applicative ConversionResult
Monad)
instance Fail.MonadFail ConversionResult where
fail :: String -> ConversionResult a
fail = Either String a -> ConversionResult a
forall dt. Either String dt -> ConversionResult dt
ConversionResult (Either String a -> ConversionResult a)
-> (String -> Either String a) -> String -> ConversionResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left
class Fail.MonadFail m => ToJulianDay m jd from where
toJulianDay :: from -> IO (m (JulianDay jd))
instance Fail.MonadFail m => ToJulianDay m 'UT UTCTime where
toJulianDay :: UTCTime -> IO (m (JulianDay 'UT))
toJulianDay = m (JulianDay 'UT) -> IO (m (JulianDay 'UT))
forall (m :: * -> *) a. Monad m => a -> m a
return (m (JulianDay 'UT) -> IO (m (JulianDay 'UT)))
-> (UTCTime -> m (JulianDay 'UT))
-> UTCTime
-> IO (m (JulianDay 'UT))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay 'UT -> m (JulianDay 'UT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JulianDay 'UT -> m (JulianDay 'UT))
-> (UTCTime -> JulianDay 'UT) -> UTCTime -> m (JulianDay 'UT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> JulianDay 'UT
utcToJulianDayUT
instance Fail.MonadFail m => ToJulianDay m 'UT1 UTCTime where
toJulianDay :: UTCTime -> IO (m (JulianDay 'UT1))
toJulianDay = UTCTime -> IO (m (JulianDay 'UT1))
forall (m :: * -> *).
MonadFail m =>
UTCTime -> IO (m (JulianDay 'UT1))
utcToJulianUT1
instance Fail.MonadFail m => ToJulianDay m 'TT UTCTime where
toJulianDay :: UTCTime -> IO (m (JulianDay 'TT))
toJulianDay = UTCTime -> IO (m (JulianDay 'TT))
forall (m :: * -> *).
MonadFail m =>
UTCTime -> IO (m (JulianDay 'TT))
utcToJulianTT
class FromJulianDay jd to where
fromJulianDay :: JulianDay jd -> IO to
instance FromJulianDay 'UT UTCTime where
fromJulianDay :: JulianDay 'UT -> IO UTCTime
fromJulianDay = UTCTime -> IO UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime)
-> (JulianDay 'UT -> UTCTime) -> JulianDay 'UT -> IO UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay 'UT -> UTCTime
julianDayUTToUTC
instance FromJulianDay 'UT1 UTCTime where
fromJulianDay :: JulianDay 'UT1 -> IO UTCTime
fromJulianDay = JulianDay 'UT1 -> IO UTCTime
julianUT1ToUTC
instance FromJulianDay 'TT UTCTime where
fromJulianDay :: JulianDay 'TT -> IO UTCTime
fromJulianDay = JulianDay 'TT -> IO UTCTime
julianTTToUTC
mkJulianDay :: SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay :: SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
_ = Double -> JulianDay ts
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay
coerceUT :: JulianDay 'UT -> JulianDay 'UT1
coerceUT :: JulianDay 'UT -> JulianDay 'UT1
coerceUT (MkJulianDay Double
jd) = Double -> JulianDay 'UT1
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay Double
jd
julianNoon :: JulianDay ts -> JulianDay ts
julianNoon :: JulianDay ts -> JulianDay ts
julianNoon (MkJulianDay Double
d) = Int -> JulianDay ts
forall a. Enum a => Int -> a
toEnum (Int -> JulianDay ts) -> (Double -> Int) -> Double -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> JulianDay ts) -> Double -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ Double
d
julianMidnight :: JulianDay ts -> JulianDay ts
julianMidnight :: JulianDay ts -> JulianDay ts
julianMidnight = Double -> JulianDay ts
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double -> JulianDay ts)
-> (JulianDay ts -> Double) -> JulianDay ts -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract Double
0.5 (Double -> Double)
-> (JulianDay ts -> Double) -> JulianDay ts -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDay ts -> Double)
-> (JulianDay ts -> JulianDay ts) -> JulianDay ts -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> JulianDay ts
forall (s :: TimeStandard). JulianDay s -> JulianDay s
julianNoon
addDeltaTime :: JulianDay 'UT1 -> Double -> JulianDay 'TT
addDeltaTime :: JulianDay 'UT1 -> Double -> JulianDay 'TT
addDeltaTime (MkJulianDay Double
jd) Double
dt = Double -> JulianDay 'TT
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double
jd Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dt)
subtractDeltaTime :: JulianDay 'TT -> Double -> JulianDay 'UT1
subtractDeltaTime :: JulianDay 'TT -> Double -> JulianDay 'UT1
subtractDeltaTime (MkJulianDay Double
jd) Double
dt = Double -> JulianDay 'UT1
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double
jd Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dt)
dayToJulianDay :: Day -> JulianDay ts
dayToJulianDay :: Day -> JulianDay ts
dayToJulianDay Day
day =
Integer -> Int -> Int -> Double -> JulianDay ts
forall (ts :: TimeStandard).
Integer -> Int -> Int -> Double -> JulianDay ts
gregorianToJulian Integer
y Int
m Int
d Double
12
where
(Integer
y, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
dayFromJulianDay :: JulianDay ts -> Day
dayFromJulianDay :: JulianDay ts -> Day
dayFromJulianDay JulianDay ts
jd =
Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d
where
(Integer
y,Int
m,Int
d,Double
_) = JulianDay ts -> (Integer, Int, Int, Double)
forall (ts :: TimeStandard).
JulianDay ts -> (Integer, Int, Int, Double)
gregorianFromJulianDay (JulianDay ts -> (Integer, Int, Int, Double))
-> (JulianDay ts -> JulianDay ts)
-> JulianDay ts
-> (Integer, Int, Int, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> JulianDay ts
forall (s :: TimeStandard). JulianDay s -> JulianDay s
julianNoon (JulianDay ts -> (Integer, Int, Int, Double))
-> JulianDay ts -> (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ JulianDay ts
jd
gregorianToJulian :: Integer -> Int -> Int -> Double -> JulianDay ts
gregorianToJulian :: Integer -> Int -> Int -> Double -> JulianDay ts
gregorianToJulian Integer
year Int
month Int
day Double
hour =
Double -> JulianDay ts
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay ts) -> CDouble -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> CInt -> CDouble -> GregFlag -> CDouble
c_swe_julday CInt
y CInt
m CInt
d CDouble
h GregFlag
gregorian
where
y :: CInt
y = Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year
m :: CInt
m = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month
d :: CInt
d = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
day
h :: CDouble
h = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
hour
gregorianToJulianDayUT :: Integer -> Int -> Int -> Double -> JulianDay 'UT
gregorianToJulianDayUT :: Integer -> Int -> Int -> Double -> JulianDay 'UT
gregorianToJulianDayUT = Integer -> Int -> Int -> Double -> JulianDay 'UT
forall (ts :: TimeStandard).
Integer -> Int -> Int -> Double -> JulianDay ts
gregorianToJulian
gregorianToFakeJulianDayTT :: Integer -> Int -> Int -> Double -> JulianDay 'TT
gregorianToFakeJulianDayTT :: Integer -> Int -> Int -> Double -> JulianDay 'TT
gregorianToFakeJulianDayTT = Integer -> Int -> Int -> Double -> JulianDay 'TT
forall (ts :: TimeStandard).
Integer -> Int -> Int -> Double -> JulianDay ts
gregorianToJulian
gregorianFromJulianDay :: JulianDay ts -> (Integer, Int, Int, Double)
gregorianFromJulianDay :: JulianDay ts -> (Integer, Int, Int, Double)
gregorianFromJulianDay (MkJulianDay Double
jd) =
IO (Integer, Int, Int, Double) -> (Integer, Int, Int, Double)
forall a. IO a -> a
unsafePerformIO (IO (Integer, Int, Int, Double) -> (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double) -> (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$
(Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double))
-> (Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jyear -> (Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double))
-> (Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmon -> (Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double))
-> (Ptr CInt -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jday -> (Ptr CDouble -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double))
-> (Ptr CDouble -> IO (Integer, Int, Int, Double))
-> IO (Integer, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
jut -> do
()
_ <-
CDouble
-> GregFlag
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CDouble
-> IO ()
c_swe_revjul
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
jd)
GregFlag
gregorian
Ptr CInt
jyear
Ptr CInt
jmon
Ptr CInt
jday
Ptr CDouble
jut
CInt
year <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jyear
CInt
month <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jmon
CInt
day <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jday
CDouble
time <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
jut
(Integer, Int, Int, Double) -> IO (Integer, Int, Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
year, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
month, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
day, CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
time)
gregorianFromJulianDayUT :: JulianDay 'UT -> (Integer, Int, Int, Double)
gregorianFromJulianDayUT :: JulianDay 'UT -> (Integer, Int, Int, Double)
gregorianFromJulianDayUT = JulianDay 'UT -> (Integer, Int, Int, Double)
forall (ts :: TimeStandard).
JulianDay ts -> (Integer, Int, Int, Double)
gregorianFromJulianDay
gregorianFromFakeJulianDayTT :: JulianDay 'TT -> (Integer, Int, Int, Double)
gregorianFromFakeJulianDayTT :: JulianDay 'TT -> (Integer, Int, Int, Double)
gregorianFromFakeJulianDayTT = JulianDay 'TT -> (Integer, Int, Int, Double)
forall (ts :: TimeStandard).
JulianDay ts -> (Integer, Int, Int, Double)
gregorianFromJulianDay
picosecondsInHour :: Double
picosecondsInHour :: Double
picosecondsInHour = Double
3600 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e12
utcToJulianDayUT :: UTCTime -> JulianDay 'UT
utcToJulianDayUT :: UTCTime -> JulianDay 'UT
utcToJulianDayUT (UTCTime Day
day DiffTime
time) =
Integer -> Int -> Int -> Double -> JulianDay 'UT
gregorianToJulianDayUT Integer
y Int
m Int
d Double
h
where
(Integer
y, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
h :: Double
h = (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
picosecondsInHour) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DiffTime -> Integer
diffTimeToPicoseconds DiffTime
time)
julianDayUTToUTC :: JulianDay 'UT -> UTCTime
julianDayUTToUTC :: JulianDay 'UT -> UTCTime
julianDayUTToUTC JulianDay 'UT
jd =
Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
dt
where
(Integer
y, Int
m, Int
d, Double
h) = JulianDay 'UT -> (Integer, Int, Int, Double)
gregorianFromJulianDayUT JulianDay 'UT
jd
day :: Day
day = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d
dt :: DiffTime
dt = Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double
h Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
picosecondsInHour
utcToJulian :: UTCTime -> JulianDay 'UT
utcToJulian :: UTCTime -> JulianDay 'UT
utcToJulian = UTCTime -> JulianDay 'UT
utcToJulianDayUT
julianToUTC :: JulianDay 'UT -> UTCTime
julianToUTC :: JulianDay 'UT -> UTCTime
julianToUTC = JulianDay 'UT -> UTCTime
julianDayUTToUTC
splitUTC :: UTCTime -> (Integer, Int, Int, TimeOfDay)
splitUTC :: UTCTime -> (Integer, Int, Int, TimeOfDay)
splitUTC (UTCTime Day
day DiffTime
time) =
(Integer
y, Int
m, Int
d, TimeOfDay
tod)
where
(Integer
y, Int
m, Int
d) = Day -> (Integer, Int, Int)
toGregorian Day
day
tod :: TimeOfDay
tod = DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
time
utcToJulianDays :: Fail.MonadFail m => UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
utcToJulianDays :: UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
utcToJulianDays UTCTime
ut =
let (Integer
y, Int
m, Int
d, TimeOfDay Int
h Int
mn Pico
s) = UTCTime -> (Integer, Int, Int, TimeOfDay)
splitUTC UTCTime
ut
in Int
-> (Ptr CDouble -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CDouble -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> (Ptr CDouble -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
dret -> (Ptr CChar -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall b. (Ptr CChar -> IO b) -> IO b
allocaErrorMessage ((Ptr CChar -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> (Ptr CChar -> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
serr -> do
CInt
retval <-
CInt
-> CInt
-> CInt
-> CInt
-> CInt
-> CDouble
-> GregFlag
-> Ptr CDouble
-> Ptr CChar
-> IO CInt
c_swe_utc_to_jd
(Integer -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mn)
(Pico -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
s)
GregFlag
gregorian
Ptr CDouble
dret
Ptr CChar
serr
if CInt
retval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then do
String
msg <- Ptr CChar -> IO String
peekCAString Ptr CChar
serr
m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall (m :: * -> *) a. Monad m => a -> m a
return (m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall a b. (a -> b) -> a -> b
$ String -> m (JulianDay 'TT, JulianDay 'UT1)
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg
else do
(CDouble
tt : CDouble
ut1 : [CDouble]
_) <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CDouble
dret
m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall (m :: * -> *) a. Monad m => a -> m a
return (m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1)))
-> m (JulianDay 'TT, JulianDay 'UT1)
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall a b. (a -> b) -> a -> b
$ (JulianDay 'TT, JulianDay 'UT1)
-> m (JulianDay 'TT, JulianDay 'UT1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> JulianDay 'TT
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double -> JulianDay 'TT)
-> (CDouble -> Double) -> CDouble -> JulianDay 'TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay 'TT) -> CDouble -> JulianDay 'TT
forall a b. (a -> b) -> a -> b
$ CDouble
tt, Double -> JulianDay 'UT1
forall (s :: TimeStandard). Double -> JulianDay s
MkJulianDay (Double -> JulianDay 'UT1)
-> (CDouble -> Double) -> CDouble -> JulianDay 'UT1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay 'UT1) -> CDouble -> JulianDay 'UT1
forall a b. (a -> b) -> a -> b
$ CDouble
ut1)
utcToJulianTT :: Fail.MonadFail m => UTCTime -> IO (m (JulianDay 'TT))
utcToJulianTT :: UTCTime -> IO (m (JulianDay 'TT))
utcToJulianTT UTCTime
ut =
((JulianDay 'TT, JulianDay 'UT1) -> JulianDay 'TT)
-> m (JulianDay 'TT, JulianDay 'UT1) -> m (JulianDay 'TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JulianDay 'TT, JulianDay 'UT1) -> JulianDay 'TT
forall a b. (a, b) -> a
fst (m (JulianDay 'TT, JulianDay 'UT1) -> m (JulianDay 'TT))
-> IO (m (JulianDay 'TT, JulianDay 'UT1)) -> IO (m (JulianDay 'TT))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall (m :: * -> *).
MonadFail m =>
UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
utcToJulianDays UTCTime
ut
utcToJulianUT1 :: Fail.MonadFail m => UTCTime -> IO (m (JulianDay 'UT1))
utcToJulianUT1 :: UTCTime -> IO (m (JulianDay 'UT1))
utcToJulianUT1 UTCTime
ut =
((JulianDay 'TT, JulianDay 'UT1) -> JulianDay 'UT1)
-> m (JulianDay 'TT, JulianDay 'UT1) -> m (JulianDay 'UT1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JulianDay 'TT, JulianDay 'UT1) -> JulianDay 'UT1
forall a b. (a, b) -> b
snd (m (JulianDay 'TT, JulianDay 'UT1) -> m (JulianDay 'UT1))
-> IO (m (JulianDay 'TT, JulianDay 'UT1))
-> IO (m (JulianDay 'UT1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
forall (m :: * -> *).
MonadFail m =>
UTCTime -> IO (m (JulianDay 'TT, JulianDay 'UT1))
utcToJulianDays UTCTime
ut
gregorianFromJulianDayTT :: JulianDay 'TT -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayTT :: JulianDay 'TT -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayTT (MkJulianDay Double
tt) = do
(Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jyear -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmon -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jday -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$
\Ptr CInt
jhour -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmin -> (Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
jsec -> do
()
_ <-
CDouble
-> GregFlag
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CDouble
-> IO ()
c_swe_jdet_to_utc
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
tt)
GregFlag
gregorian
Ptr CInt
jyear
Ptr CInt
jmon
Ptr CInt
jday
Ptr CInt
jhour
Ptr CInt
jmin
Ptr CDouble
jsec
CInt
year <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jyear
CInt
month <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jmon
CInt
day <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jday
CInt
hour <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jhour
CInt
minute <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jmin
CDouble
second <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
jsec
(Integer, Int, Int, TimeOfDay) -> IO (Integer, Int, Int, TimeOfDay)
forall (m :: * -> *) a. Monad m => a -> m a
return
( CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
year,
CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
month,
CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
day,
Int -> Int -> Pico -> TimeOfDay
TimeOfDay (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
hour) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
minute) (CDouble -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
second)
)
gregorianFromJulianDayUT1 :: JulianDay 'UT1 -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayUT1 :: JulianDay 'UT1 -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayUT1 (MkJulianDay Double
ut1) = do
(Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jyear -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmon -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jday -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$
\Ptr CInt
jhour -> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CInt -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmin -> (Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay))
-> (Ptr CDouble -> IO (Integer, Int, Int, TimeOfDay))
-> IO (Integer, Int, Int, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
jsec -> do
()
_ <-
CDouble
-> GregFlag
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CDouble
-> IO ()
c_swe_jdut1_to_utc
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ut1)
GregFlag
gregorian
Ptr CInt
jyear
Ptr CInt
jmon
Ptr CInt
jday
Ptr CInt
jhour
Ptr CInt
jmin
Ptr CDouble
jsec
CInt
year <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jyear
CInt
month <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jmon
CInt
day <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jday
CInt
hour <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jhour
CInt
minute <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
jmin
CDouble
second <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
jsec
(Integer, Int, Int, TimeOfDay) -> IO (Integer, Int, Int, TimeOfDay)
forall (m :: * -> *) a. Monad m => a -> m a
return
( CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
year,
CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
month,
CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
day,
Int -> Int -> Pico -> TimeOfDay
TimeOfDay (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
hour) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
minute) (CDouble -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
second)
)
julianTTToUTC :: JulianDay 'TT -> IO UTCTime
julianTTToUTC :: JulianDay 'TT -> IO UTCTime
julianTTToUTC JulianDay 'TT
tt = do
(Integer
y, Int
m, Int
d, TimeOfDay
tod) <- JulianDay 'TT -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayTT JulianDay 'TT
tt
UTCTime -> IO UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d) (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
julianUT1ToUTC :: JulianDay 'UT1 -> IO UTCTime
julianUT1ToUTC :: JulianDay 'UT1 -> IO UTCTime
julianUT1ToUTC JulianDay 'UT1
ut1 = do
(Integer
y, Int
m, Int
d, TimeOfDay
tod) <- JulianDay 'UT1 -> IO (Integer, Int, Int, TimeOfDay)
gregorianFromJulianDayUT1 JulianDay 'UT1
ut1
UTCTime -> IO UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> IO UTCTime) -> UTCTime -> IO UTCTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d) (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
unsafeDeltaTime :: JulianDay 'UT1 -> IO Double
unsafeDeltaTime :: JulianDay 'UT1 -> IO Double
unsafeDeltaTime (MkJulianDay Double
jd) =
CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> IO CDouble -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CDouble -> IO CDouble
c_swe_deltat (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
jd)
deltaTime :: JulianDay 'UT1 -> IO Double
deltaTime :: JulianDay 'UT1 -> IO Double
deltaTime = JulianDay 'UT1 -> IO Double
unsafeDeltaTime
safeDeltaTime :: Fail.MonadFail m => EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
safeDeltaTime :: EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
safeDeltaTime EphemerisOption
epheOption (MkJulianDay Double
jd) =
(Ptr CChar -> IO (m Double)) -> IO (m Double)
forall b. (Ptr CChar -> IO b) -> IO b
allocaErrorMessage ((Ptr CChar -> IO (m Double)) -> IO (m Double))
-> (Ptr CChar -> IO (m Double)) -> IO (m Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
serr -> do
CDouble
dt <- CDouble -> EpheFlag -> Ptr CChar -> IO CDouble
c_swe_deltat_ex (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
jd) (EphemerisOption -> EpheFlag
ephemerisOptionToFlag EphemerisOption
epheOption) Ptr CChar
serr
if CDouble
dt CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
0
then do
String
err <- Ptr CChar -> IO String
peekCAString Ptr CChar
serr
m Double -> IO (m Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Double -> IO (m Double)) -> m Double -> IO (m Double)
forall a b. (a -> b) -> a -> b
$ String -> m Double
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
err
else do
m Double -> IO (m Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Double -> IO (m Double))
-> (CDouble -> m Double) -> CDouble -> IO (m Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> m Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double -> m Double) -> (CDouble -> Double) -> CDouble -> m Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> IO (m Double)) -> CDouble -> IO (m Double)
forall a b. (a -> b) -> a -> b
$ CDouble
dt
deltaTimeSE :: Fail.MonadFail m => JulianDay 'UT1 -> IO (m Double)
deltaTimeSE :: JulianDay 'UT1 -> IO (m Double)
deltaTimeSE = EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
forall (m :: * -> *).
MonadFail m =>
EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
safeDeltaTime EphemerisOption
UseSwissEphemeris
universalToTerrestrial :: JulianDay 'UT1 -> IO (JulianDay 'TT)
universalToTerrestrial :: JulianDay 'UT1 -> IO (JulianDay 'TT)
universalToTerrestrial JulianDay 'UT1
jdut = do
Double
deltaT <- JulianDay 'UT1 -> IO Double
unsafeDeltaTime JulianDay 'UT1
jdut
JulianDay 'TT -> IO (JulianDay 'TT)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JulianDay 'TT -> IO (JulianDay 'TT))
-> JulianDay 'TT -> IO (JulianDay 'TT)
forall a b. (a -> b) -> a -> b
$ JulianDay 'UT1 -> Double -> JulianDay 'TT
addDeltaTime JulianDay 'UT1
jdut Double
deltaT
universalToTerrestrialSafe :: Fail.MonadFail m => EphemerisOption -> JulianDay 'UT1 -> IO (m (JulianDay 'TT))
universalToTerrestrialSafe :: EphemerisOption -> JulianDay 'UT1 -> IO (m (JulianDay 'TT))
universalToTerrestrialSafe EphemerisOption
eo JulianDay 'UT1
jdut = do
m Double
deltaT <- EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
forall (m :: * -> *).
MonadFail m =>
EphemerisOption -> JulianDay 'UT1 -> IO (m Double)
safeDeltaTime EphemerisOption
eo JulianDay 'UT1
jdut
m (JulianDay 'TT) -> IO (m (JulianDay 'TT))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (JulianDay 'TT) -> IO (m (JulianDay 'TT)))
-> m (JulianDay 'TT) -> IO (m (JulianDay 'TT))
forall a b. (a -> b) -> a -> b
$ JulianDay 'UT1 -> Double -> JulianDay 'TT
addDeltaTime JulianDay 'UT1
jdut (Double -> JulianDay 'TT) -> m Double -> m (JulianDay 'TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Double
deltaT
universalToTerrestrialSE :: Fail.MonadFail m => JulianDay 'UT1 -> IO (m (JulianDay 'TT))
universalToTerrestrialSE :: JulianDay 'UT1 -> IO (m (JulianDay 'TT))
universalToTerrestrialSE = EphemerisOption -> JulianDay 'UT1 -> IO (m (JulianDay 'TT))
forall (m :: * -> *).
MonadFail m =>
EphemerisOption -> JulianDay 'UT1 -> IO (m (JulianDay 'TT))
universalToTerrestrialSafe EphemerisOption
UseSwissEphemeris
julianToSiderealSimple :: JulianDay 'UT1 -> IO SiderealTime
julianToSiderealSimple :: JulianDay 'UT1 -> IO SiderealTime
julianToSiderealSimple (MkJulianDay Double
jt) = do
CDouble
sidTime <- CDouble -> IO CDouble
c_swe_sidtime (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
jt)
SiderealTime -> IO SiderealTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SiderealTime -> IO SiderealTime)
-> (Double -> SiderealTime) -> Double -> IO SiderealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SiderealTime
SiderealTime (Double -> IO SiderealTime) -> Double -> IO SiderealTime
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
sidTime
julianToSidereal :: JulianDay 'UT1 -> ObliquityInformation -> IO SiderealTime
julianToSidereal :: JulianDay 'UT1 -> ObliquityInformation -> IO SiderealTime
julianToSidereal (MkJulianDay Double
jt) ObliquityInformation
on = do
let obliq :: CDouble
obliq = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
on
nut :: CDouble
nut = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ ObliquityInformation -> Double
nutationLongitude ObliquityInformation
on
CDouble
sidTime <- CDouble -> CDouble -> CDouble -> IO CDouble
c_swe_sidtime0 (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
jt) CDouble
obliq CDouble
nut
SiderealTime -> IO SiderealTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SiderealTime -> IO SiderealTime)
-> (Double -> SiderealTime) -> Double -> IO SiderealTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> SiderealTime
SiderealTime (Double -> IO SiderealTime) -> Double -> IO SiderealTime
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
sidTime