{-|
Module: Data.Astro.Time.Sidereal
Description: Sidereal Time
Copyright: Alexander Ignatyev, 2016

According to the Sidereal Clock any observed star returns to the same position
in the sky every 24 hours.

Each sidereal day is shorter than the solar day, 24 hours of sidereal time
corresponding to 23:56:04.0916 of solar time.
-}

module Data.Astro.Time.Sidereal
(
  GreenwichSiderealTime
  , LocalSiderealTime
  , dhToGST
  , dhToLST
  , gstToDH
  , lstToDH
  , hmsToGST
  , hmsToLST
  , utToGST
  , gstToUT
  , gstToLST
  , lstToGST
  , lstToGSTwDC
)
where

import Data.Astro.Types (DecimalHours(..), fromHMS)
import Data.Astro.Time.JulianDate (JulianDate(..), TimeBaseType, numberOfCenturies, splitToDayAndTime)
import Data.Astro.Time.Epoch (j2000)
import Data.Astro.Utils (reduceToZeroRange)
import qualified Data.Astro.Types as C


-- | Greenwich Sidereal Time

-- GST can be in range [-12h, 36h] carrying out a day correction

newtype GreenwichSiderealTime = GST TimeBaseType deriving (Int -> GreenwichSiderealTime -> ShowS
[GreenwichSiderealTime] -> ShowS
GreenwichSiderealTime -> String
(Int -> GreenwichSiderealTime -> ShowS)
-> (GreenwichSiderealTime -> String)
-> ([GreenwichSiderealTime] -> ShowS)
-> Show GreenwichSiderealTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GreenwichSiderealTime] -> ShowS
$cshowList :: [GreenwichSiderealTime] -> ShowS
show :: GreenwichSiderealTime -> String
$cshow :: GreenwichSiderealTime -> String
showsPrec :: Int -> GreenwichSiderealTime -> ShowS
$cshowsPrec :: Int -> GreenwichSiderealTime -> ShowS
Show, GreenwichSiderealTime -> GreenwichSiderealTime -> Bool
(GreenwichSiderealTime -> GreenwichSiderealTime -> Bool)
-> (GreenwichSiderealTime -> GreenwichSiderealTime -> Bool)
-> Eq GreenwichSiderealTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GreenwichSiderealTime -> GreenwichSiderealTime -> Bool
$c/= :: GreenwichSiderealTime -> GreenwichSiderealTime -> Bool
== :: GreenwichSiderealTime -> GreenwichSiderealTime -> Bool
$c== :: GreenwichSiderealTime -> GreenwichSiderealTime -> Bool
Eq)


-- | Local Sidereal Time

newtype LocalSiderealTime = LST TimeBaseType deriving (Int -> LocalSiderealTime -> ShowS
[LocalSiderealTime] -> ShowS
LocalSiderealTime -> String
(Int -> LocalSiderealTime -> ShowS)
-> (LocalSiderealTime -> String)
-> ([LocalSiderealTime] -> ShowS)
-> Show LocalSiderealTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalSiderealTime] -> ShowS
$cshowList :: [LocalSiderealTime] -> ShowS
show :: LocalSiderealTime -> String
$cshow :: LocalSiderealTime -> String
showsPrec :: Int -> LocalSiderealTime -> ShowS
$cshowsPrec :: Int -> LocalSiderealTime -> ShowS
Show, LocalSiderealTime -> LocalSiderealTime -> Bool
(LocalSiderealTime -> LocalSiderealTime -> Bool)
-> (LocalSiderealTime -> LocalSiderealTime -> Bool)
-> Eq LocalSiderealTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalSiderealTime -> LocalSiderealTime -> Bool
$c/= :: LocalSiderealTime -> LocalSiderealTime -> Bool
== :: LocalSiderealTime -> LocalSiderealTime -> Bool
$c== :: LocalSiderealTime -> LocalSiderealTime -> Bool
Eq)


-- | Convert Decimal Hours to Greenwich Sidereal Time

dhToGST :: DecimalHours -> GreenwichSiderealTime
dhToGST :: DecimalHours -> GreenwichSiderealTime
dhToGST (DH Double
t) = Double -> GreenwichSiderealTime
GST Double
t


-- | Convert Decimal Hours to Local Sidereal Time

dhToLST :: DecimalHours -> LocalSiderealTime
dhToLST :: DecimalHours -> LocalSiderealTime
dhToLST (DH Double
t) = Double -> LocalSiderealTime
LST Double
t


-- | Convert Greenwich Sidereal Time to Decimal Hours

gstToDH :: GreenwichSiderealTime -> DecimalHours
gstToDH :: GreenwichSiderealTime -> DecimalHours
gstToDH (GST Double
t) = Double -> DecimalHours
DH Double
t


-- | Convert Local Sidereal Time to Decimal Hours

lstToDH :: LocalSiderealTime -> DecimalHours
lstToDH :: LocalSiderealTime -> DecimalHours
lstToDH (LST Double
t) = Double -> DecimalHours
DH Double
t


-- | Comvert Hours, Minutes, Seconds to Greenwich Sidereal Time

hmsToGST :: Int -> Int -> TimeBaseType -> GreenwichSiderealTime
hmsToGST :: Int -> Int -> Double -> GreenwichSiderealTime
hmsToGST Int
h Int
m Double
s = DecimalHours -> GreenwichSiderealTime
dhToGST (DecimalHours -> GreenwichSiderealTime)
-> DecimalHours -> GreenwichSiderealTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
h Int
m Double
s


-- | Comvert Hours, Minutes, Seconds to Local Sidereal Time

hmsToLST :: Int -> Int -> TimeBaseType -> LocalSiderealTime
hmsToLST :: Int -> Int -> Double -> LocalSiderealTime
hmsToLST Int
h Int
m Double
s = DecimalHours -> LocalSiderealTime
dhToLST (DecimalHours -> LocalSiderealTime)
-> DecimalHours -> LocalSiderealTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
h Int
m Double
s


-- | Convert from Universal Time (UT) to Greenwich Sidereal Time (GST)

utToGST :: JulianDate -> GreenwichSiderealTime
utToGST :: JulianDate -> GreenwichSiderealTime
utToGST JulianDate
jd =
  let (JD Double
day, JD Double
time) = JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime JulianDate
jd
      t :: Double
t = Double -> Double
solarSiderealTimesDiff Double
day
      time' :: Double
time' = Double -> Double -> Double
forall a. RealFrac a => a -> a -> a
reduceToZeroRange Double
24 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
timeDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
24Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
siderealDayLength Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t
  in Double -> GreenwichSiderealTime
GST (Double -> GreenwichSiderealTime)
-> Double -> GreenwichSiderealTime
forall a b. (a -> b) -> a -> b
$ Double
time'


-- | Convert from Greenwich Sidereal Time (GST) to Universal Time (UT).

-- It takes GST and Greenwich Date, returns JulianDate.

-- Because the sidereal day is shorter than the solar day (see comment to the module).

-- In case of such ambiguity the early time will be returned.

-- You can easily check the ambiguity: if time is equal or less 00:03:56

-- you can get the second time by adding 23:56:04

gstToUT :: JulianDate -> GreenwichSiderealTime -> JulianDate
gstToUT :: JulianDate -> GreenwichSiderealTime -> JulianDate
gstToUT JulianDate
jd GreenwichSiderealTime
gst =
  let (Double
day, Double
time) = JulianDate -> GreenwichSiderealTime -> (Double, Double)
dayTime JulianDate
jd GreenwichSiderealTime
gst
      t :: Double
t = Double -> Double
solarSiderealTimesDiff Double
day
      time' :: Double
time' = (Double -> Double -> Double
forall a. RealFrac a => a -> a -> a
reduceToZeroRange Double
24 (Double
timeDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
siderealDayLength
  in Double -> JulianDate
JD (Double -> JulianDate) -> Double -> JulianDate
forall a b. (a -> b) -> a -> b
$ Double
day Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
time'Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
24
  where dayTime :: JulianDate -> GreenwichSiderealTime -> (Double, Double)
dayTime JulianDate
jd (GST Double
gst)
          | Double
gst Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0   = (Double
dayDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1, Double
gstDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
24)
          | Double
gst Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
24 = (Double
dayDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
1, Double
gstDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
24)
          | Bool
otherwise = (Double
day,   Double
gst)
            where (JD Double
day, JulianDate
_) = JulianDate -> (JulianDate, JulianDate)
splitToDayAndTime JulianDate
jd


-- | Convert Greenwich Sidereal Time to Local Sidereal Time.

-- It takes GST and longitude in decimal degrees

gstToLST :: C.DecimalDegrees -> GreenwichSiderealTime -> LocalSiderealTime
gstToLST :: DecimalDegrees -> GreenwichSiderealTime -> LocalSiderealTime
gstToLST DecimalDegrees
longitude (GST Double
gst) =
  let C.DH Double
dhours = DecimalDegrees -> DecimalHours
C.toDecimalHours DecimalDegrees
longitude
      lst :: Double
lst = Double -> Double -> Double
forall a. RealFrac a => a -> a -> a
reduceToZeroRange Double
24 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
gst Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dhours
  in Double -> LocalSiderealTime
LST Double
lst


-- | Convert Local Sidereal Time to Greenwich Sidereal Time

-- It takes LST and longitude in decimal degrees

lstToGST :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime
lstToGST :: DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime
lstToGST DecimalDegrees
longitude (LST Double
lst) =
  let C.DH Double
dhours = DecimalDegrees -> DecimalHours
C.toDecimalHours DecimalDegrees
longitude
      gst :: Double
gst = Double -> Double -> Double
forall a. RealFrac a => a -> a -> a
reduceToZeroRange Double
24 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
lst Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dhours
  in Double -> GreenwichSiderealTime
GST Double
gst


-- | Convert Local Sidereal Time to Greenwich Sidereal Time with Day Correction.

-- It takes LST and longitude in decimal degrees

lstToGSTwDC :: C.DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime
lstToGSTwDC :: DecimalDegrees -> LocalSiderealTime -> GreenwichSiderealTime
lstToGSTwDC DecimalDegrees
longitude (LST Double
lst) =
  let C.DH Double
dhours = DecimalDegrees -> DecimalHours
C.toDecimalHours DecimalDegrees
longitude
      gst :: Double
gst = Double
lst Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dhours
  in Double -> GreenwichSiderealTime
GST Double
gst


-- Sidereal time internal functions


-- sidereal 24h correspond to 23:56:04 of solar time

siderealDayLength :: TimeBaseType
siderealDayLength :: Double
siderealDayLength = Double
hoursDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
24
  where C.DH Double
hours = Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
23 Int
56 Double
04.0916


solarSiderealTimesDiff :: TimeBaseType -> TimeBaseType
solarSiderealTimesDiff :: Double -> Double
solarSiderealTimesDiff Double
d =
  let t :: Double
t = JulianDate -> JulianDate -> Double
numberOfCenturies JulianDate
j2000 (Double -> JulianDate
JD Double
d)
  in Double -> Double -> Double
forall a. RealFrac a => a -> a -> a
reduceToZeroRange Double
24 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
6.697374558 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2400.051336Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.000025862Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
t