{-|
Module: Data.Astro.Planet.PlanetDetails
Description: Planet Details
Copyright: Alexander Ignatyev, 2016-2017

Planet Details.
-}

module Data.Astro.Planet.PlanetDetails
(
  Planet(..)
  , PlanetDetails(..)
  , j2010PlanetDetails
  , isInnerPlanet
)

where

import Data.Astro.Types (DecimalDegrees(..), AstronomicalUnits, fromDMS)
import Data.Astro.Time.JulianDate (JulianDate)
import Data.Astro.Time.Epoch (j2010)


-- | Planets of the Solar System

data Planet = Mercury
             | Venus
             | Earth 
             | Mars
             | Jupiter
             | Saturn
             | Uranus
             | Neptune
               deriving (Int -> Planet -> ShowS
[Planet] -> ShowS
Planet -> String
(Int -> Planet -> ShowS)
-> (Planet -> String) -> ([Planet] -> ShowS) -> Show Planet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Planet] -> ShowS
$cshowList :: [Planet] -> ShowS
show :: Planet -> String
$cshow :: Planet -> String
showsPrec :: Int -> Planet -> ShowS
$cshowsPrec :: Int -> Planet -> ShowS
Show, Planet -> Planet -> Bool
(Planet -> Planet -> Bool)
-> (Planet -> Planet -> Bool) -> Eq Planet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Planet -> Planet -> Bool
$c/= :: Planet -> Planet -> Bool
== :: Planet -> Planet -> Bool
$c== :: Planet -> Planet -> Bool
Eq)


-- | Details of the planetary orbit at the epoch

data PlanetDetails = PlanetDetails {
  PlanetDetails -> Planet
pdPlanet :: Planet
  , PlanetDetails -> JulianDate
pdEpoch :: JulianDate
  , PlanetDetails -> Double
pdTp :: Double               -- ^ Orbital period in tropical years

  , PlanetDetails -> DecimalDegrees
pdEpsilon :: DecimalDegrees  -- ^ Longitude at the Epoch

  , PlanetDetails -> DecimalDegrees
pdOmegaBar :: DecimalDegrees -- ^ Longitude of the perihelion

  , PlanetDetails -> Double
pdE :: Double                -- ^ Eccentricity of the orbit

  , PlanetDetails -> AstronomicalUnits
pdAlpha :: AstronomicalUnits -- ^ Semi-major axis of the orbit in AU

  , PlanetDetails -> DecimalDegrees
pdI :: DecimalDegrees        -- ^ Orbital inclination

  , PlanetDetails -> DecimalDegrees
pdBigOmega :: DecimalDegrees -- ^ Longitude of the ascending node

  , PlanetDetails -> DecimalDegrees
pdBigTheta :: DecimalDegrees -- ^ Angular diameter at 1 AU

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


-- | Return True if the planet is inner (its orbit lies inside the Earth's orbit)

isInnerPlanet :: PlanetDetails -> Bool
isInnerPlanet :: PlanetDetails -> Bool
isInnerPlanet PlanetDetails
pd
  | PlanetDetails -> Planet
pdPlanet PlanetDetails
pd Planet -> Planet -> Bool
forall a. Eq a => a -> a -> Bool
== Planet
Mercury = Bool
True
  | PlanetDetails -> Planet
pdPlanet PlanetDetails
pd Planet -> Planet -> Bool
forall a. Eq a => a -> a -> Bool
== Planet
Venus = Bool
True
  | Bool
otherwise = Bool
False


-- | PlanetDetails at the reference Epoch J2010.0

j2010PlanetDetails :: Planet -> PlanetDetails
--                                                 Epoch Tp         Epsilon    Omega Bar  e        alpha    i        Big Omega Big Theta

j2010PlanetDetails :: Planet -> PlanetDetails
j2010PlanetDetails Planet
Mercury = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Mercury JulianDate
j2010 Double
0.24085    DecimalDegrees
75.5671    DecimalDegrees
77.612     Double
0.205627 AstronomicalUnits
0.387098 DecimalDegrees
7.0051   DecimalDegrees
48.449    (Double -> DecimalDegrees
arcsecs Double
6.74)
j2010PlanetDetails Planet
Venus   = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Venus   JulianDate
j2010 Double
0.615207   DecimalDegrees
272.30044  DecimalDegrees
131.54     Double
0.006812 AstronomicalUnits
0.723329 DecimalDegrees
3.3947   DecimalDegrees
76.769    (Double -> DecimalDegrees
arcsecs Double
16.92)
j2010PlanetDetails Planet
Earth   = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Earth   JulianDate
j2010 Double
0.999996   DecimalDegrees
99.556772  DecimalDegrees
103.2055   Double
0.016671 AstronomicalUnits
0.999985 DecimalDegrees
0        DecimalDegrees
0         (Double -> DecimalDegrees
arcsecs Double
0)
j2010PlanetDetails Planet
Mars    = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Mars    JulianDate
j2010 Double
1.880765   DecimalDegrees
109.09646  DecimalDegrees
336.217    Double
0.093348 AstronomicalUnits
1.523689 DecimalDegrees
1.8497   DecimalDegrees
49.632    (Double -> DecimalDegrees
arcsecs Double
9.36)
j2010PlanetDetails Planet
Jupiter = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Jupiter JulianDate
j2010 Double
11.857911  DecimalDegrees
337.917132 DecimalDegrees
14.6633    Double
0.048907 AstronomicalUnits
5.20278  DecimalDegrees
1.3035   DecimalDegrees
100.595   (Double -> DecimalDegrees
arcsecs Double
196.74)
j2010PlanetDetails Planet
Saturn  = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Saturn  JulianDate
j2010 Double
29.310579  DecimalDegrees
172.398316 DecimalDegrees
89.567     Double
0.053853 AstronomicalUnits
9.51134  DecimalDegrees
2.4873   DecimalDegrees
113.752   (Double -> DecimalDegrees
arcsecs Double
165.6)
j2010PlanetDetails Planet
Uranus  = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Uranus  JulianDate
j2010 Double
84.039492  DecimalDegrees
356.135400 DecimalDegrees
172.884833 Double
0.046321 AstronomicalUnits
19.21814 DecimalDegrees
0.773059 DecimalDegrees
73.926961 (Double -> DecimalDegrees
arcsecs Double
65.8)
j2010PlanetDetails Planet
Neptune = Planet
-> JulianDate
-> Double
-> DecimalDegrees
-> DecimalDegrees
-> Double
-> AstronomicalUnits
-> DecimalDegrees
-> DecimalDegrees
-> DecimalDegrees
-> PlanetDetails
PlanetDetails Planet
Neptune JulianDate
j2010 Double
165.845392 DecimalDegrees
326.895127 DecimalDegrees
23.07      Double
0.010483 AstronomicalUnits
30.1985  DecimalDegrees
1.7673   DecimalDegrees
131.879   (Double -> DecimalDegrees
arcsecs Double
62.2)

-- | arcseconds to DecimalHours

arcsecs :: Double -> DecimalDegrees
arcsecs = Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
0 Int
0