{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module: SwissEphemeris.Internal
-- Description: helper functions and types, not for public consumption.
--
-- The types defined here are exported publicly for convenience, but at least in versions <= 2.x, they're likely to evolve.
module SwissEphemeris.Internal where

import Data.Bits
import Data.Char (ord)
import Foreign (Int32, castPtr, allocaArray, Ptr)
import Foreign.C.Types
import Foreign.SwissEphemeris
import GHC.Generics
import Foreign.Storable

-- | For objects that can be placed along the ecliptic
-- in a 1-dimensional "longitude-only" manner.
class Eq a => HasEclipticLongitude a where
  getEclipticLongitude :: a -> Double

-- | All bodies for which a position can be calculated. Covers planets
-- in the solar system, points between the Earth and the Moon, and
-- astrologically significant asteroids (currently, only Chiron, but
-- ephemerides data is available for others.)
-- More at <https://www.astro.com/swisseph/swisseph.htm#_Toc46391648 2.1 Planetary and lunar ephemerides>
-- and <https://www.astro.com/swisseph/swephprg.htm#_Toc49847827 3.2 bodies>
data Planet
  = Sun
  | Moon
  | Mercury
  | Venus
  | Mars
  | Jupiter
  | Saturn
  | Uranus
  | Neptune
  | Pluto
  | MeanNode
  | TrueNode
  | MeanApog
  | OscuApog
  | Earth
  | Chiron
  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, Eq Planet
Eq Planet
-> (Planet -> Planet -> Ordering)
-> (Planet -> Planet -> Bool)
-> (Planet -> Planet -> Bool)
-> (Planet -> Planet -> Bool)
-> (Planet -> Planet -> Bool)
-> (Planet -> Planet -> Planet)
-> (Planet -> Planet -> Planet)
-> Ord Planet
Planet -> Planet -> Bool
Planet -> Planet -> Ordering
Planet -> Planet -> Planet
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 :: Planet -> Planet -> Planet
$cmin :: Planet -> Planet -> Planet
max :: Planet -> Planet -> Planet
$cmax :: Planet -> Planet -> Planet
>= :: Planet -> Planet -> Bool
$c>= :: Planet -> Planet -> Bool
> :: Planet -> Planet -> Bool
$c> :: Planet -> Planet -> Bool
<= :: Planet -> Planet -> Bool
$c<= :: Planet -> Planet -> Bool
< :: Planet -> Planet -> Bool
$c< :: Planet -> Planet -> Bool
compare :: Planet -> Planet -> Ordering
$ccompare :: Planet -> Planet -> Ordering
$cp1Ord :: Eq Planet
Ord, Int -> Planet
Planet -> Int
Planet -> [Planet]
Planet -> Planet
Planet -> Planet -> [Planet]
Planet -> Planet -> Planet -> [Planet]
(Planet -> Planet)
-> (Planet -> Planet)
-> (Int -> Planet)
-> (Planet -> Int)
-> (Planet -> [Planet])
-> (Planet -> Planet -> [Planet])
-> (Planet -> Planet -> [Planet])
-> (Planet -> Planet -> Planet -> [Planet])
-> Enum Planet
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Planet -> Planet -> Planet -> [Planet]
$cenumFromThenTo :: Planet -> Planet -> Planet -> [Planet]
enumFromTo :: Planet -> Planet -> [Planet]
$cenumFromTo :: Planet -> Planet -> [Planet]
enumFromThen :: Planet -> Planet -> [Planet]
$cenumFromThen :: Planet -> Planet -> [Planet]
enumFrom :: Planet -> [Planet]
$cenumFrom :: Planet -> [Planet]
fromEnum :: Planet -> Int
$cfromEnum :: Planet -> Int
toEnum :: Int -> Planet
$ctoEnum :: Int -> Planet
pred :: Planet -> Planet
$cpred :: Planet -> Planet
succ :: Planet -> Planet
$csucc :: Planet -> Planet
Enum, (forall x. Planet -> Rep Planet x)
-> (forall x. Rep Planet x -> Planet) -> Generic Planet
forall x. Rep Planet x -> Planet
forall x. Planet -> Rep Planet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Planet x -> Planet
$cfrom :: forall x. Planet -> Rep Planet x
Generic)

-- | When marshaling a @Planet@ to/from C,
-- use the underlying integer @PlanetNumber@.
instance Storable Planet where
  sizeOf :: Planet -> Int
sizeOf Planet
_ = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined::CInt)
  alignment :: Planet -> Int
alignment = Planet -> Int
forall a. Storable a => a -> Int
sizeOf
  peek :: Ptr Planet -> IO Planet
peek Ptr Planet
ptr = do
    PlanetNumber
planetN <- Ptr PlanetNumber -> IO PlanetNumber
forall a. Storable a => Ptr a -> IO a
peek (Ptr PlanetNumber -> IO PlanetNumber)
-> Ptr PlanetNumber -> IO PlanetNumber
forall a b. (a -> b) -> a -> b
$ Ptr Planet -> Ptr PlanetNumber
forall a b. Ptr a -> Ptr b
castPtr Ptr Planet
ptr
    Planet -> IO Planet
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Planet -> IO Planet) -> Planet -> IO Planet
forall a b. (a -> b) -> a -> b
$ PlanetNumber -> Planet
numberToPlanet PlanetNumber
planetN
  poke :: Ptr Planet -> Planet -> IO ()
poke Ptr Planet
ptr Planet
p =
    Ptr PlanetNumber -> PlanetNumber -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Planet -> Ptr PlanetNumber
forall a b. Ptr a -> Ptr b
castPtr Ptr Planet
ptr) (Planet -> PlanetNumber
planetNumber Planet
p)


-- | The major house systems. The underlying library supports many more, including the
-- 36-cusp outlier Gauquelin.
-- More info at <https://www.astro.com/swisseph/swisseph.htm#_Toc46391705 6.2 Astrological house systems>
-- and <https://www.astro.com/swisseph/swephprg.htm#_Toc49847888 14. House cusp calculation>
data HouseSystem
  = Placidus
  | Koch
  | Porphyrius
  | Regiomontanus
  | Campanus
  | Equal
  | WholeSign
  deriving (Int -> HouseSystem -> ShowS
[HouseSystem] -> ShowS
HouseSystem -> String
(Int -> HouseSystem -> ShowS)
-> (HouseSystem -> String)
-> ([HouseSystem] -> ShowS)
-> Show HouseSystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HouseSystem] -> ShowS
$cshowList :: [HouseSystem] -> ShowS
show :: HouseSystem -> String
$cshow :: HouseSystem -> String
showsPrec :: Int -> HouseSystem -> ShowS
$cshowsPrec :: Int -> HouseSystem -> ShowS
Show, HouseSystem -> HouseSystem -> Bool
(HouseSystem -> HouseSystem -> Bool)
-> (HouseSystem -> HouseSystem -> Bool) -> Eq HouseSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HouseSystem -> HouseSystem -> Bool
$c/= :: HouseSystem -> HouseSystem -> Bool
== :: HouseSystem -> HouseSystem -> Bool
$c== :: HouseSystem -> HouseSystem -> Bool
Eq, Eq HouseSystem
Eq HouseSystem
-> (HouseSystem -> HouseSystem -> Ordering)
-> (HouseSystem -> HouseSystem -> Bool)
-> (HouseSystem -> HouseSystem -> Bool)
-> (HouseSystem -> HouseSystem -> Bool)
-> (HouseSystem -> HouseSystem -> Bool)
-> (HouseSystem -> HouseSystem -> HouseSystem)
-> (HouseSystem -> HouseSystem -> HouseSystem)
-> Ord HouseSystem
HouseSystem -> HouseSystem -> Bool
HouseSystem -> HouseSystem -> Ordering
HouseSystem -> HouseSystem -> HouseSystem
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 :: HouseSystem -> HouseSystem -> HouseSystem
$cmin :: HouseSystem -> HouseSystem -> HouseSystem
max :: HouseSystem -> HouseSystem -> HouseSystem
$cmax :: HouseSystem -> HouseSystem -> HouseSystem
>= :: HouseSystem -> HouseSystem -> Bool
$c>= :: HouseSystem -> HouseSystem -> Bool
> :: HouseSystem -> HouseSystem -> Bool
$c> :: HouseSystem -> HouseSystem -> Bool
<= :: HouseSystem -> HouseSystem -> Bool
$c<= :: HouseSystem -> HouseSystem -> Bool
< :: HouseSystem -> HouseSystem -> Bool
$c< :: HouseSystem -> HouseSystem -> Bool
compare :: HouseSystem -> HouseSystem -> Ordering
$ccompare :: HouseSystem -> HouseSystem -> Ordering
$cp1Ord :: Eq HouseSystem
Ord, Int -> HouseSystem
HouseSystem -> Int
HouseSystem -> [HouseSystem]
HouseSystem -> HouseSystem
HouseSystem -> HouseSystem -> [HouseSystem]
HouseSystem -> HouseSystem -> HouseSystem -> [HouseSystem]
(HouseSystem -> HouseSystem)
-> (HouseSystem -> HouseSystem)
-> (Int -> HouseSystem)
-> (HouseSystem -> Int)
-> (HouseSystem -> [HouseSystem])
-> (HouseSystem -> HouseSystem -> [HouseSystem])
-> (HouseSystem -> HouseSystem -> [HouseSystem])
-> (HouseSystem -> HouseSystem -> HouseSystem -> [HouseSystem])
-> Enum HouseSystem
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HouseSystem -> HouseSystem -> HouseSystem -> [HouseSystem]
$cenumFromThenTo :: HouseSystem -> HouseSystem -> HouseSystem -> [HouseSystem]
enumFromTo :: HouseSystem -> HouseSystem -> [HouseSystem]
$cenumFromTo :: HouseSystem -> HouseSystem -> [HouseSystem]
enumFromThen :: HouseSystem -> HouseSystem -> [HouseSystem]
$cenumFromThen :: HouseSystem -> HouseSystem -> [HouseSystem]
enumFrom :: HouseSystem -> [HouseSystem]
$cenumFrom :: HouseSystem -> [HouseSystem]
fromEnum :: HouseSystem -> Int
$cfromEnum :: HouseSystem -> Int
toEnum :: Int -> HouseSystem
$ctoEnum :: Int -> HouseSystem
pred :: HouseSystem -> HouseSystem
$cpred :: HouseSystem -> HouseSystem
succ :: HouseSystem -> HouseSystem
$csucc :: HouseSystem -> HouseSystem
Enum, (forall x. HouseSystem -> Rep HouseSystem x)
-> (forall x. Rep HouseSystem x -> HouseSystem)
-> Generic HouseSystem
forall x. Rep HouseSystem x -> HouseSystem
forall x. HouseSystem -> Rep HouseSystem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HouseSystem x -> HouseSystem
$cfrom :: forall x. HouseSystem -> Rep HouseSystem x
Generic)

-- | Represents western zodiac signs. Unless otherwise stated, they correspond to tropical
-- divisions of the ecliptic, vs. the actual constellations.
data ZodiacSignName
  = Aries
  | Taurus
  | Gemini
  | Cancer
  | Leo
  | Virgo
  | Libra
  | Scorpio
  | Sagittarius
  | Capricorn
  | Aquarius
  | Pisces
  deriving (ZodiacSignName -> ZodiacSignName -> Bool
(ZodiacSignName -> ZodiacSignName -> Bool)
-> (ZodiacSignName -> ZodiacSignName -> Bool) -> Eq ZodiacSignName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZodiacSignName -> ZodiacSignName -> Bool
$c/= :: ZodiacSignName -> ZodiacSignName -> Bool
== :: ZodiacSignName -> ZodiacSignName -> Bool
$c== :: ZodiacSignName -> ZodiacSignName -> Bool
Eq, Int -> ZodiacSignName -> ShowS
[ZodiacSignName] -> ShowS
ZodiacSignName -> String
(Int -> ZodiacSignName -> ShowS)
-> (ZodiacSignName -> String)
-> ([ZodiacSignName] -> ShowS)
-> Show ZodiacSignName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZodiacSignName] -> ShowS
$cshowList :: [ZodiacSignName] -> ShowS
show :: ZodiacSignName -> String
$cshow :: ZodiacSignName -> String
showsPrec :: Int -> ZodiacSignName -> ShowS
$cshowsPrec :: Int -> ZodiacSignName -> ShowS
Show, Int -> ZodiacSignName
ZodiacSignName -> Int
ZodiacSignName -> [ZodiacSignName]
ZodiacSignName -> ZodiacSignName
ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
ZodiacSignName
-> ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
(ZodiacSignName -> ZodiacSignName)
-> (ZodiacSignName -> ZodiacSignName)
-> (Int -> ZodiacSignName)
-> (ZodiacSignName -> Int)
-> (ZodiacSignName -> [ZodiacSignName])
-> (ZodiacSignName -> ZodiacSignName -> [ZodiacSignName])
-> (ZodiacSignName -> ZodiacSignName -> [ZodiacSignName])
-> (ZodiacSignName
    -> ZodiacSignName -> ZodiacSignName -> [ZodiacSignName])
-> Enum ZodiacSignName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ZodiacSignName
-> ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
$cenumFromThenTo :: ZodiacSignName
-> ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
enumFromTo :: ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
$cenumFromTo :: ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
enumFromThen :: ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
$cenumFromThen :: ZodiacSignName -> ZodiacSignName -> [ZodiacSignName]
enumFrom :: ZodiacSignName -> [ZodiacSignName]
$cenumFrom :: ZodiacSignName -> [ZodiacSignName]
fromEnum :: ZodiacSignName -> Int
$cfromEnum :: ZodiacSignName -> Int
toEnum :: Int -> ZodiacSignName
$ctoEnum :: Int -> ZodiacSignName
pred :: ZodiacSignName -> ZodiacSignName
$cpred :: ZodiacSignName -> ZodiacSignName
succ :: ZodiacSignName -> ZodiacSignName
$csucc :: ZodiacSignName -> ZodiacSignName
Enum, (forall x. ZodiacSignName -> Rep ZodiacSignName x)
-> (forall x. Rep ZodiacSignName x -> ZodiacSignName)
-> Generic ZodiacSignName
forall x. Rep ZodiacSignName x -> ZodiacSignName
forall x. ZodiacSignName -> Rep ZodiacSignName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ZodiacSignName x -> ZodiacSignName
$cfrom :: forall x. ZodiacSignName -> Rep ZodiacSignName x
Generic)

-- | Nakshatras, provided for thoroughness, please excuse any misspellings!
-- List from: https://en.wikipedia.org/wiki/List_of_Nakshatras
-- note that the underlying library uses 27 nakshatras, so Abhijit is
-- omitted.
data NakshatraName
  = Ashvini
  | Bharani
  | Krittika
  | Rohini
  | Mrigashirsha
  | Ardra
  | Punarvasu
  | Pushya
  | Ashlesha
  | Magha
  | PurvaPhalghuni
  | UttaraPhalguni
  | Hasta
  | Chitra
  | Swati
  | Vishakha
  | Anuradha
  | Jyeshtha
  | Mula
  | PurvaAshadha
  | UttaraAshadha
  | Sravana
  | Dhanishta
  | Shatabhisha
  | PurvaBhadrapada
  | UttaraBhadrapada
  | Revati
  deriving (NakshatraName -> NakshatraName -> Bool
(NakshatraName -> NakshatraName -> Bool)
-> (NakshatraName -> NakshatraName -> Bool) -> Eq NakshatraName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NakshatraName -> NakshatraName -> Bool
$c/= :: NakshatraName -> NakshatraName -> Bool
== :: NakshatraName -> NakshatraName -> Bool
$c== :: NakshatraName -> NakshatraName -> Bool
Eq, Int -> NakshatraName -> ShowS
[NakshatraName] -> ShowS
NakshatraName -> String
(Int -> NakshatraName -> ShowS)
-> (NakshatraName -> String)
-> ([NakshatraName] -> ShowS)
-> Show NakshatraName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NakshatraName] -> ShowS
$cshowList :: [NakshatraName] -> ShowS
show :: NakshatraName -> String
$cshow :: NakshatraName -> String
showsPrec :: Int -> NakshatraName -> ShowS
$cshowsPrec :: Int -> NakshatraName -> ShowS
Show, Int -> NakshatraName
NakshatraName -> Int
NakshatraName -> [NakshatraName]
NakshatraName -> NakshatraName
NakshatraName -> NakshatraName -> [NakshatraName]
NakshatraName -> NakshatraName -> NakshatraName -> [NakshatraName]
(NakshatraName -> NakshatraName)
-> (NakshatraName -> NakshatraName)
-> (Int -> NakshatraName)
-> (NakshatraName -> Int)
-> (NakshatraName -> [NakshatraName])
-> (NakshatraName -> NakshatraName -> [NakshatraName])
-> (NakshatraName -> NakshatraName -> [NakshatraName])
-> (NakshatraName
    -> NakshatraName -> NakshatraName -> [NakshatraName])
-> Enum NakshatraName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NakshatraName -> NakshatraName -> NakshatraName -> [NakshatraName]
$cenumFromThenTo :: NakshatraName -> NakshatraName -> NakshatraName -> [NakshatraName]
enumFromTo :: NakshatraName -> NakshatraName -> [NakshatraName]
$cenumFromTo :: NakshatraName -> NakshatraName -> [NakshatraName]
enumFromThen :: NakshatraName -> NakshatraName -> [NakshatraName]
$cenumFromThen :: NakshatraName -> NakshatraName -> [NakshatraName]
enumFrom :: NakshatraName -> [NakshatraName]
$cenumFrom :: NakshatraName -> [NakshatraName]
fromEnum :: NakshatraName -> Int
$cfromEnum :: NakshatraName -> Int
toEnum :: Int -> NakshatraName
$ctoEnum :: Int -> NakshatraName
pred :: NakshatraName -> NakshatraName
$cpred :: NakshatraName -> NakshatraName
succ :: NakshatraName -> NakshatraName
$csucc :: NakshatraName -> NakshatraName
Enum, (forall x. NakshatraName -> Rep NakshatraName x)
-> (forall x. Rep NakshatraName x -> NakshatraName)
-> Generic NakshatraName
forall x. Rep NakshatraName x -> NakshatraName
forall x. NakshatraName -> Rep NakshatraName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NakshatraName x -> NakshatraName
$cfrom :: forall x. NakshatraName -> Rep NakshatraName x
Generic)

-- | Options to split a `Double` representing degrees:
-- RoundSeconds  -- round at the seconds granularity (omits seconds fraction.)
-- RoundMinutes  -- round at the minutes granularity.
-- RoundDegrees  -- round at the degrees granularity.
-- SplitZodiacal -- relative to zodiac signs.
-- SplitNakshatra -- relative to nakshatra.
-- KeepSign       -- when rounding, don't round if it'll move it to the next zodiac/nakshatra sector.
-- KeepDegrees    -- when rounding, don't round if it'll move it to the next degree.
data SplitDegreesOption
  = RoundSeconds
  | RoundMinutes
  | RoundDegrees
  | SplitZodiacal
  | SplitNakshatra
  | KeepSign
  | KeepDegrees
  deriving (SplitDegreesOption -> SplitDegreesOption -> Bool
(SplitDegreesOption -> SplitDegreesOption -> Bool)
-> (SplitDegreesOption -> SplitDegreesOption -> Bool)
-> Eq SplitDegreesOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitDegreesOption -> SplitDegreesOption -> Bool
$c/= :: SplitDegreesOption -> SplitDegreesOption -> Bool
== :: SplitDegreesOption -> SplitDegreesOption -> Bool
$c== :: SplitDegreesOption -> SplitDegreesOption -> Bool
Eq, Int -> SplitDegreesOption -> ShowS
[SplitDegreesOption] -> ShowS
SplitDegreesOption -> String
(Int -> SplitDegreesOption -> ShowS)
-> (SplitDegreesOption -> String)
-> ([SplitDegreesOption] -> ShowS)
-> Show SplitDegreesOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SplitDegreesOption] -> ShowS
$cshowList :: [SplitDegreesOption] -> ShowS
show :: SplitDegreesOption -> String
$cshow :: SplitDegreesOption -> String
showsPrec :: Int -> SplitDegreesOption -> ShowS
$cshowsPrec :: Int -> SplitDegreesOption -> ShowS
Show, Int -> SplitDegreesOption
SplitDegreesOption -> Int
SplitDegreesOption -> [SplitDegreesOption]
SplitDegreesOption -> SplitDegreesOption
SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
SplitDegreesOption
-> SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
(SplitDegreesOption -> SplitDegreesOption)
-> (SplitDegreesOption -> SplitDegreesOption)
-> (Int -> SplitDegreesOption)
-> (SplitDegreesOption -> Int)
-> (SplitDegreesOption -> [SplitDegreesOption])
-> (SplitDegreesOption
    -> SplitDegreesOption -> [SplitDegreesOption])
-> (SplitDegreesOption
    -> SplitDegreesOption -> [SplitDegreesOption])
-> (SplitDegreesOption
    -> SplitDegreesOption
    -> SplitDegreesOption
    -> [SplitDegreesOption])
-> Enum SplitDegreesOption
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SplitDegreesOption
-> SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
$cenumFromThenTo :: SplitDegreesOption
-> SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
enumFromTo :: SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
$cenumFromTo :: SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
enumFromThen :: SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
$cenumFromThen :: SplitDegreesOption -> SplitDegreesOption -> [SplitDegreesOption]
enumFrom :: SplitDegreesOption -> [SplitDegreesOption]
$cenumFrom :: SplitDegreesOption -> [SplitDegreesOption]
fromEnum :: SplitDegreesOption -> Int
$cfromEnum :: SplitDegreesOption -> Int
toEnum :: Int -> SplitDegreesOption
$ctoEnum :: Int -> SplitDegreesOption
pred :: SplitDegreesOption -> SplitDegreesOption
$cpred :: SplitDegreesOption -> SplitDegreesOption
succ :: SplitDegreesOption -> SplitDegreesOption
$csucc :: SplitDegreesOption -> SplitDegreesOption
Enum, (forall x. SplitDegreesOption -> Rep SplitDegreesOption x)
-> (forall x. Rep SplitDegreesOption x -> SplitDegreesOption)
-> Generic SplitDegreesOption
forall x. Rep SplitDegreesOption x -> SplitDegreesOption
forall x. SplitDegreesOption -> Rep SplitDegreesOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SplitDegreesOption x -> SplitDegreesOption
$cfrom :: forall x. SplitDegreesOption -> Rep SplitDegreesOption x
Generic)

-- | Represents an instant in Julian time.
-- see:
-- <https://www.astro.com/swisseph/swephprg.htm#_Toc49847871 8. Date and time conversion functions>
-- also cf. @julianDay@
newtype JulianTime = JulianTime {JulianTime -> Double
unJulianTime :: Double}
  deriving (Int -> JulianTime -> ShowS
[JulianTime] -> ShowS
JulianTime -> String
(Int -> JulianTime -> ShowS)
-> (JulianTime -> String)
-> ([JulianTime] -> ShowS)
-> Show JulianTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JulianTime] -> ShowS
$cshowList :: [JulianTime] -> ShowS
show :: JulianTime -> String
$cshow :: JulianTime -> String
showsPrec :: Int -> JulianTime -> ShowS
$cshowsPrec :: Int -> JulianTime -> ShowS
Show, JulianTime -> JulianTime -> Bool
(JulianTime -> JulianTime -> Bool)
-> (JulianTime -> JulianTime -> Bool) -> Eq JulianTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JulianTime -> JulianTime -> Bool
$c/= :: JulianTime -> JulianTime -> Bool
== :: JulianTime -> JulianTime -> Bool
$c== :: JulianTime -> JulianTime -> Bool
Eq, Eq JulianTime
Eq JulianTime
-> (JulianTime -> JulianTime -> Ordering)
-> (JulianTime -> JulianTime -> Bool)
-> (JulianTime -> JulianTime -> Bool)
-> (JulianTime -> JulianTime -> Bool)
-> (JulianTime -> JulianTime -> Bool)
-> (JulianTime -> JulianTime -> JulianTime)
-> (JulianTime -> JulianTime -> JulianTime)
-> Ord JulianTime
JulianTime -> JulianTime -> Bool
JulianTime -> JulianTime -> Ordering
JulianTime -> JulianTime -> JulianTime
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 :: JulianTime -> JulianTime -> JulianTime
$cmin :: JulianTime -> JulianTime -> JulianTime
max :: JulianTime -> JulianTime -> JulianTime
$cmax :: JulianTime -> JulianTime -> JulianTime
>= :: JulianTime -> JulianTime -> Bool
$c>= :: JulianTime -> JulianTime -> Bool
> :: JulianTime -> JulianTime -> Bool
$c> :: JulianTime -> JulianTime -> Bool
<= :: JulianTime -> JulianTime -> Bool
$c<= :: JulianTime -> JulianTime -> Bool
< :: JulianTime -> JulianTime -> Bool
$c< :: JulianTime -> JulianTime -> Bool
compare :: JulianTime -> JulianTime -> Ordering
$ccompare :: JulianTime -> JulianTime -> Ordering
$cp1Ord :: Eq JulianTime
Ord)

-- | Represents an instant in sidereal time
newtype SiderealTime = SiderealTime {SiderealTime -> Double
unSiderealTime :: 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)

-- | The cusp of a given "house" or "sector". It is an ecliptic longitude.
-- see:
-- <https://www.astro.com/swisseph/swephprg.htm#_Toc49847888 14.1 House cusp calculation>
-- and <https://www.astro.com/swisseph/swisseph.htm#_Toc46391705 6.2 Astrological house systems>
type HouseCusp = Double

-- | Position data for a celestial body on the ecliptic, includes rotational speeds.
-- see:
-- <https://www.astro.com/swisseph/swephprg.htm#_Toc49847837 3.4 Position and speed>
data EclipticPosition = EclipticPosition
  { EclipticPosition -> Double
lng :: Double,
    EclipticPosition -> Double
lat :: Double,
    EclipticPosition -> Double
distance :: Double, -- in AU
    EclipticPosition -> Double
lngSpeed :: Double, -- deg/day
    EclipticPosition -> Double
latSpeed :: Double, -- deg/day
    EclipticPosition -> Double
distSpeed :: Double -- deg/day
  }
  deriving (Int -> EclipticPosition -> ShowS
[EclipticPosition] -> ShowS
EclipticPosition -> String
(Int -> EclipticPosition -> ShowS)
-> (EclipticPosition -> String)
-> ([EclipticPosition] -> ShowS)
-> Show EclipticPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EclipticPosition] -> ShowS
$cshowList :: [EclipticPosition] -> ShowS
show :: EclipticPosition -> String
$cshow :: EclipticPosition -> String
showsPrec :: Int -> EclipticPosition -> ShowS
$cshowsPrec :: Int -> EclipticPosition -> ShowS
Show, EclipticPosition -> EclipticPosition -> Bool
(EclipticPosition -> EclipticPosition -> Bool)
-> (EclipticPosition -> EclipticPosition -> Bool)
-> Eq EclipticPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EclipticPosition -> EclipticPosition -> Bool
$c/= :: EclipticPosition -> EclipticPosition -> Bool
== :: EclipticPosition -> EclipticPosition -> Bool
$c== :: EclipticPosition -> EclipticPosition -> Bool
Eq, (forall x. EclipticPosition -> Rep EclipticPosition x)
-> (forall x. Rep EclipticPosition x -> EclipticPosition)
-> Generic EclipticPosition
forall x. Rep EclipticPosition x -> EclipticPosition
forall x. EclipticPosition -> Rep EclipticPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EclipticPosition x -> EclipticPosition
$cfrom :: forall x. EclipticPosition -> Rep EclipticPosition x
Generic)

instance HasEclipticLongitude EclipticPosition where
  getEclipticLongitude :: EclipticPosition -> Double
getEclipticLongitude = EclipticPosition -> Double
lng

-- | Represents a point on Earth, with negative values
-- for latitude meaning South, and negative values for longitude
-- meaning West. No speed information is included (or needed,)
-- because all calculations are geocentric.
data GeographicPosition = GeographicPosition
  { GeographicPosition -> Double
geoLat :: Double,
    GeographicPosition -> Double
geoLng :: Double
  }
  deriving (Int -> GeographicPosition -> ShowS
[GeographicPosition] -> ShowS
GeographicPosition -> String
(Int -> GeographicPosition -> ShowS)
-> (GeographicPosition -> String)
-> ([GeographicPosition] -> ShowS)
-> Show GeographicPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeographicPosition] -> ShowS
$cshowList :: [GeographicPosition] -> ShowS
show :: GeographicPosition -> String
$cshow :: GeographicPosition -> String
showsPrec :: Int -> GeographicPosition -> ShowS
$cshowsPrec :: Int -> GeographicPosition -> ShowS
Show, GeographicPosition -> GeographicPosition -> Bool
(GeographicPosition -> GeographicPosition -> Bool)
-> (GeographicPosition -> GeographicPosition -> Bool)
-> Eq GeographicPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GeographicPosition -> GeographicPosition -> Bool
$c/= :: GeographicPosition -> GeographicPosition -> Bool
== :: GeographicPosition -> GeographicPosition -> Bool
$c== :: GeographicPosition -> GeographicPosition -> Bool
Eq, (forall x. GeographicPosition -> Rep GeographicPosition x)
-> (forall x. Rep GeographicPosition x -> GeographicPosition)
-> Generic GeographicPosition
forall x. Rep GeographicPosition x -> GeographicPosition
forall x. GeographicPosition -> Rep GeographicPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeographicPosition x -> GeographicPosition
$cfrom :: forall x. GeographicPosition -> Rep GeographicPosition x
Generic)

-- | Represents a position on the celestial sphere,
-- with speed information included.
data EquatorialPosition = EquatorialPosition
  { EquatorialPosition -> Double
rightAscension :: Double,
    EquatorialPosition -> Double
declination :: Double,
    EquatorialPosition -> Double
eqDistance :: Double, -- same as distance in `EclipticPosition`, uses AU
    EquatorialPosition -> Double
ascensionSpeed :: Double, -- deg/day
    EquatorialPosition -> Double
declinationSpeed :: Double, -- deg/day
    EquatorialPosition -> Double
eqDistanceSpeed :: Double -- deg/day
  }
  deriving (Int -> EquatorialPosition -> ShowS
[EquatorialPosition] -> ShowS
EquatorialPosition -> String
(Int -> EquatorialPosition -> ShowS)
-> (EquatorialPosition -> String)
-> ([EquatorialPosition] -> ShowS)
-> Show EquatorialPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EquatorialPosition] -> ShowS
$cshowList :: [EquatorialPosition] -> ShowS
show :: EquatorialPosition -> String
$cshow :: EquatorialPosition -> String
showsPrec :: Int -> EquatorialPosition -> ShowS
$cshowsPrec :: Int -> EquatorialPosition -> ShowS
Show, EquatorialPosition -> EquatorialPosition -> Bool
(EquatorialPosition -> EquatorialPosition -> Bool)
-> (EquatorialPosition -> EquatorialPosition -> Bool)
-> Eq EquatorialPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EquatorialPosition -> EquatorialPosition -> Bool
$c/= :: EquatorialPosition -> EquatorialPosition -> Bool
== :: EquatorialPosition -> EquatorialPosition -> Bool
$c== :: EquatorialPosition -> EquatorialPosition -> Bool
Eq, (forall x. EquatorialPosition -> Rep EquatorialPosition x)
-> (forall x. Rep EquatorialPosition x -> EquatorialPosition)
-> Generic EquatorialPosition
forall x. Rep EquatorialPosition x -> EquatorialPosition
forall x. EquatorialPosition -> Rep EquatorialPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EquatorialPosition x -> EquatorialPosition
$cfrom :: forall x. EquatorialPosition -> Rep EquatorialPosition x
Generic)

-- | Includes the obliquity of the ecliptic, the Nutation as longitude
-- as well as mean values.
data ObliquityInformation = ObliquityInformation
  { ObliquityInformation -> Double
eclipticObliquity :: Double,
    ObliquityInformation -> Double
eclipticMeanObliquity :: Double,
    ObliquityInformation -> Double
nutationLongitude :: Double,
    ObliquityInformation -> Double
nutationObliquity :: Double
  }
  deriving (Int -> ObliquityInformation -> ShowS
[ObliquityInformation] -> ShowS
ObliquityInformation -> String
(Int -> ObliquityInformation -> ShowS)
-> (ObliquityInformation -> String)
-> ([ObliquityInformation] -> ShowS)
-> Show ObliquityInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObliquityInformation] -> ShowS
$cshowList :: [ObliquityInformation] -> ShowS
show :: ObliquityInformation -> String
$cshow :: ObliquityInformation -> String
showsPrec :: Int -> ObliquityInformation -> ShowS
$cshowsPrec :: Int -> ObliquityInformation -> ShowS
Show, ObliquityInformation -> ObliquityInformation -> Bool
(ObliquityInformation -> ObliquityInformation -> Bool)
-> (ObliquityInformation -> ObliquityInformation -> Bool)
-> Eq ObliquityInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObliquityInformation -> ObliquityInformation -> Bool
$c/= :: ObliquityInformation -> ObliquityInformation -> Bool
== :: ObliquityInformation -> ObliquityInformation -> Bool
$c== :: ObliquityInformation -> ObliquityInformation -> Bool
Eq, (forall x. ObliquityInformation -> Rep ObliquityInformation x)
-> (forall x. Rep ObliquityInformation x -> ObliquityInformation)
-> Generic ObliquityInformation
forall x. Rep ObliquityInformation x -> ObliquityInformation
forall x. ObliquityInformation -> Rep ObliquityInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObliquityInformation x -> ObliquityInformation
$cfrom :: forall x. ObliquityInformation -> Rep ObliquityInformation x
Generic)

-- | The house a celestial body is in.
data HousePosition = HousePosition
  { HousePosition -> Int
houseNumber :: Int,
    HousePosition -> Double
houseCuspDistance :: Double
  }
  deriving (Int -> HousePosition -> ShowS
[HousePosition] -> ShowS
HousePosition -> String
(Int -> HousePosition -> ShowS)
-> (HousePosition -> String)
-> ([HousePosition] -> ShowS)
-> Show HousePosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HousePosition] -> ShowS
$cshowList :: [HousePosition] -> ShowS
show :: HousePosition -> String
$cshow :: HousePosition -> String
showsPrec :: Int -> HousePosition -> ShowS
$cshowsPrec :: Int -> HousePosition -> ShowS
Show, HousePosition -> HousePosition -> Bool
(HousePosition -> HousePosition -> Bool)
-> (HousePosition -> HousePosition -> Bool) -> Eq HousePosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HousePosition -> HousePosition -> Bool
$c/= :: HousePosition -> HousePosition -> Bool
== :: HousePosition -> HousePosition -> Bool
$c== :: HousePosition -> HousePosition -> Bool
Eq, (forall x. HousePosition -> Rep HousePosition x)
-> (forall x. Rep HousePosition x -> HousePosition)
-> Generic HousePosition
forall x. Rep HousePosition x -> HousePosition
forall x. HousePosition -> Rep HousePosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HousePosition x -> HousePosition
$cfrom :: forall x. HousePosition -> Rep HousePosition x
Generic)

-- | Relevant angles: ascendant and MC, plus other "exotic" ones:
-- <https://www.astro.com/swisseph/swephprg.htm#_Toc49847890 14. House cusp calculation>
data Angles = Angles
  { Angles -> Double
ascendant :: Double,
    Angles -> Double
mc :: Double,
    Angles -> Double
armc :: Double,
    Angles -> Double
vertex :: Double,
    Angles -> Double
equatorialAscendant :: Double,
    Angles -> Double
coAscendantKoch :: Double,
    Angles -> Double
coAscendantMunkasey :: Double,
    Angles -> Double
polarAscendant :: Double
  }
  deriving (Int -> Angles -> ShowS
[Angles] -> ShowS
Angles -> String
(Int -> Angles -> ShowS)
-> (Angles -> String) -> ([Angles] -> ShowS) -> Show Angles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Angles] -> ShowS
$cshowList :: [Angles] -> ShowS
show :: Angles -> String
$cshow :: Angles -> String
showsPrec :: Int -> Angles -> ShowS
$cshowsPrec :: Int -> Angles -> ShowS
Show, Angles -> Angles -> Bool
(Angles -> Angles -> Bool)
-> (Angles -> Angles -> Bool) -> Eq Angles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Angles -> Angles -> Bool
$c/= :: Angles -> Angles -> Bool
== :: Angles -> Angles -> Bool
$c== :: Angles -> Angles -> Bool
Eq, (forall x. Angles -> Rep Angles x)
-> (forall x. Rep Angles x -> Angles) -> Generic Angles
forall x. Rep Angles x -> Angles
forall x. Angles -> Rep Angles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Angles x -> Angles
$cfrom :: forall x. Angles -> Rep Angles x
Generic)

-- | Result of calculating the cusps for a given event; will include a list of
-- cusps (most systems use 12 cusps, Gauquelin uses 36.)
data CuspsCalculation = CuspsCalculation
  { CuspsCalculation -> [Double]
houseCusps :: [HouseCusp],
    CuspsCalculation -> Angles
angles :: Angles,
    CuspsCalculation -> HouseSystem
systemUsed :: HouseSystem
  }
  deriving (Int -> CuspsCalculation -> ShowS
[CuspsCalculation] -> ShowS
CuspsCalculation -> String
(Int -> CuspsCalculation -> ShowS)
-> (CuspsCalculation -> String)
-> ([CuspsCalculation] -> ShowS)
-> Show CuspsCalculation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CuspsCalculation] -> ShowS
$cshowList :: [CuspsCalculation] -> ShowS
show :: CuspsCalculation -> String
$cshow :: CuspsCalculation -> String
showsPrec :: Int -> CuspsCalculation -> ShowS
$cshowsPrec :: Int -> CuspsCalculation -> ShowS
Show, CuspsCalculation -> CuspsCalculation -> Bool
(CuspsCalculation -> CuspsCalculation -> Bool)
-> (CuspsCalculation -> CuspsCalculation -> Bool)
-> Eq CuspsCalculation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CuspsCalculation -> CuspsCalculation -> Bool
$c/= :: CuspsCalculation -> CuspsCalculation -> Bool
== :: CuspsCalculation -> CuspsCalculation -> Bool
$c== :: CuspsCalculation -> CuspsCalculation -> Bool
Eq, (forall x. CuspsCalculation -> Rep CuspsCalculation x)
-> (forall x. Rep CuspsCalculation x -> CuspsCalculation)
-> Generic CuspsCalculation
forall x. Rep CuspsCalculation x -> CuspsCalculation
forall x. CuspsCalculation -> Rep CuspsCalculation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CuspsCalculation x -> CuspsCalculation
$cfrom :: forall x. CuspsCalculation -> Rep CuspsCalculation x
Generic)

-- | A longitude expressed in its constituent parts.
data LongitudeComponents = LongitudeComponents
  { LongitudeComponents -> Maybe ZodiacSignName
longitudeZodiacSign :: Maybe ZodiacSignName,
    LongitudeComponents -> Integer
longitudeDegrees :: Integer,
    LongitudeComponents -> Integer
longitudeMinutes :: Integer,
    LongitudeComponents -> Integer
longitudeSeconds :: Integer,
    LongitudeComponents -> Double
longitudeSecondsFraction :: Double,
    LongitudeComponents -> Maybe Int
longitudeSignum :: Maybe Int,
    LongitudeComponents -> Maybe NakshatraName
longitudeNakshatra :: Maybe NakshatraName
  }
  deriving (Int -> LongitudeComponents -> ShowS
[LongitudeComponents] -> ShowS
LongitudeComponents -> String
(Int -> LongitudeComponents -> ShowS)
-> (LongitudeComponents -> String)
-> ([LongitudeComponents] -> ShowS)
-> Show LongitudeComponents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LongitudeComponents] -> ShowS
$cshowList :: [LongitudeComponents] -> ShowS
show :: LongitudeComponents -> String
$cshow :: LongitudeComponents -> String
showsPrec :: Int -> LongitudeComponents -> ShowS
$cshowsPrec :: Int -> LongitudeComponents -> ShowS
Show, LongitudeComponents -> LongitudeComponents -> Bool
(LongitudeComponents -> LongitudeComponents -> Bool)
-> (LongitudeComponents -> LongitudeComponents -> Bool)
-> Eq LongitudeComponents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LongitudeComponents -> LongitudeComponents -> Bool
$c/= :: LongitudeComponents -> LongitudeComponents -> Bool
== :: LongitudeComponents -> LongitudeComponents -> Bool
$c== :: LongitudeComponents -> LongitudeComponents -> Bool
Eq, (forall x. LongitudeComponents -> Rep LongitudeComponents x)
-> (forall x. Rep LongitudeComponents x -> LongitudeComponents)
-> Generic LongitudeComponents
forall x. Rep LongitudeComponents x -> LongitudeComponents
forall x. LongitudeComponents -> Rep LongitudeComponents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LongitudeComponents x -> LongitudeComponents
$cfrom :: forall x. LongitudeComponents -> Rep LongitudeComponents x
Generic)

-- folders for bitwise flags, and some opinionated defaults.

mkCalculationOptions :: [CalcFlag] -> CalcFlag
mkCalculationOptions :: [CalcFlag] -> CalcFlag
mkCalculationOptions = CInt -> CalcFlag
CalcFlag (CInt -> CalcFlag)
-> ([CalcFlag] -> CInt) -> [CalcFlag] -> CalcFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CalcFlag -> CInt -> CInt) -> CInt -> [CalcFlag] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt)
-> (CalcFlag -> CInt) -> CalcFlag -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalcFlag -> CInt
unCalcFlag) CInt
0

defaultCalculationOptions :: [CalcFlag]
defaultCalculationOptions :: [CalcFlag]
defaultCalculationOptions = [CalcFlag
speed, CalcFlag
swissEph]

foldSplitDegOptions :: [SplitDegFlag] -> SplitDegFlag
foldSplitDegOptions :: [SplitDegFlag] -> SplitDegFlag
foldSplitDegOptions = CInt -> SplitDegFlag
SplitDegFlag (CInt -> SplitDegFlag)
-> ([SplitDegFlag] -> CInt) -> [SplitDegFlag] -> SplitDegFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SplitDegFlag -> CInt -> CInt) -> CInt -> [SplitDegFlag] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt)
-> (SplitDegFlag -> CInt) -> SplitDegFlag -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SplitDegFlag -> CInt
unSplitDegFlag) CInt
0

splitOptionToFlag :: SplitDegreesOption -> SplitDegFlag
splitOptionToFlag :: SplitDegreesOption -> SplitDegFlag
splitOptionToFlag SplitDegreesOption
RoundSeconds = SplitDegFlag
splitRoundSec
splitOptionToFlag SplitDegreesOption
RoundMinutes = SplitDegFlag
splitRoundMin
splitOptionToFlag SplitDegreesOption
RoundDegrees = SplitDegFlag
splitRoundDeg
splitOptionToFlag SplitDegreesOption
SplitZodiacal = SplitDegFlag
splitZodiacal
splitOptionToFlag SplitDegreesOption
SplitNakshatra = SplitDegFlag
splitNakshatra
splitOptionToFlag SplitDegreesOption
KeepSign = SplitDegFlag
splitKeepSign
splitOptionToFlag SplitDegreesOption
KeepDegrees = SplitDegFlag
splitKeepDeg

-- | Convenient defaults when using `splitDegrees`:
-- Omit rounding if it would bring it over the next sign or degree.
defaultSplitDegreesOptions :: [SplitDegreesOption]
defaultSplitDegreesOptions :: [SplitDegreesOption]
defaultSplitDegreesOptions = [SplitDegreesOption
KeepSign, SplitDegreesOption
KeepDegrees]

-- Helpers

-- in the C lib, house systems are expected as ASCII
-- codes for specific characters (!)
-- documentation at: https://www.astro.com/swisseph/swephprg.htm#_Toc19111265
toHouseSystemFlag :: HouseSystem -> Int
toHouseSystemFlag :: HouseSystem -> Int
toHouseSystemFlag HouseSystem
Placidus = Char -> Int
ord Char
'P'
toHouseSystemFlag HouseSystem
Koch = Char -> Int
ord Char
'K'
toHouseSystemFlag HouseSystem
Porphyrius = Char -> Int
ord Char
'O'
toHouseSystemFlag HouseSystem
Regiomontanus = Char -> Int
ord Char
'R'
toHouseSystemFlag HouseSystem
Campanus = Char -> Int
ord Char
'C'
toHouseSystemFlag HouseSystem
Equal = Char -> Int
ord Char
'A'
toHouseSystemFlag HouseSystem
WholeSign = Char -> Int
ord Char
'W'

coordinatesFromList :: [Double] -> EclipticPosition
-- N.B. note that for some reason the SWE guys really like lng,lat coordinates
-- though only for this one function: https://www.astro.com/swisseph/swephprg.htm#_Toc19111235
coordinatesFromList :: [Double] -> EclipticPosition
coordinatesFromList (Double
sLng : Double
sLat : Double
c : Double
d : Double
e : Double
f : [Double]
_) = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> EclipticPosition
EclipticPosition Double
sLng Double
sLat Double
c Double
d Double
e Double
f
-- the underlying library goes to great lengths to not return fewer than 6 data,
-- it instead uses zeroes for unavailable entries.
coordinatesFromList [Double]
_ = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> EclipticPosition
EclipticPosition Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

eclipticFromList :: [Double] -> EclipticPosition
eclipticFromList :: [Double] -> EclipticPosition
eclipticFromList = [Double] -> EclipticPosition
coordinatesFromList

eclipticToList :: EclipticPosition -> [Double]
eclipticToList :: EclipticPosition -> [Double]
eclipticToList (EclipticPosition Double
sLng Double
sLat Double
c Double
d Double
e Double
f) = [Double
sLng, Double
sLat, Double
c, Double
d, Double
e, Double
f]

equatorialFromList :: [Double] -> EquatorialPosition
equatorialFromList :: [Double] -> EquatorialPosition
equatorialFromList (Double
a : Double
b : Double
c : Double
d : Double
e : Double
f : [Double]
_) = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> EquatorialPosition
EquatorialPosition Double
a Double
b Double
c Double
d Double
e Double
f
equatorialFromList [Double]
_ = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> EquatorialPosition
EquatorialPosition Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

equatorialToList :: EquatorialPosition -> [Double]
equatorialToList :: EquatorialPosition -> [Double]
equatorialToList (EquatorialPosition Double
a Double
b Double
c Double
d Double
e Double
f) = [Double
a, Double
b, Double
c, Double
d, Double
e, Double
f]

obliquityNutationFromList :: [Double] -> ObliquityInformation
obliquityNutationFromList :: [Double] -> ObliquityInformation
obliquityNutationFromList (Double
a : Double
b : Double
c : Double
d : Double
_ : Double
_ : [Double]
_) = Double -> Double -> Double -> Double -> ObliquityInformation
ObliquityInformation Double
a Double
b Double
c Double
d
obliquityNutationFromList [Double]
_ = Double -> Double -> Double -> Double -> ObliquityInformation
ObliquityInformation Double
0 Double
0 Double
0 Double
0

anglesFromList :: [Double] -> Angles
anglesFromList :: [Double] -> Angles
anglesFromList (Double
a : Double
_mc : Double
_armc : Double
vtx : Double
ea : Double
cak : Double
cam : Double
pa : Double
_ : [Double]
_) =
  Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Angles
Angles Double
a Double
_mc Double
_armc Double
vtx Double
ea Double
cak Double
cam Double
pa
-- the underlying library always returns _something_, defaulting to zero
-- if the angle calculation doesn't apply.
anglesFromList [Double]
_ = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Angles
Angles Double
0 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

planetNumber :: Planet -> PlanetNumber
planetNumber :: Planet -> PlanetNumber
planetNumber Planet
p = CInt -> PlanetNumber
PlanetNumber (CInt -> PlanetNumber) -> CInt -> PlanetNumber
forall a b. (a -> b) -> a -> b
$ Int32 -> CInt
CInt Int32
y
  where
    y :: Int32
y = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Planet -> Int
forall a. Enum a => a -> Int
fromEnum Planet
p :: Int32

numberToPlanet :: PlanetNumber -> Planet
numberToPlanet :: PlanetNumber -> Planet
numberToPlanet (PlanetNumber (CInt Int32
n)) =
  Int -> Planet
forall a. Enum a => Int -> a
toEnum (Int -> Planet) -> (Int32 -> Int) -> Int32 -> Planet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Planet) -> Int32 -> Planet
forall a b. (a -> b) -> a -> b
$ Int32
n

-- | As per the programmers manual, error output strings
-- should accommodate at most 256 characters:
-- see @sweodef.h#266@ and the manual:
-- https://www.astro.com/swisseph/swephprg.htm
-- in e.g. 
allocaErrorMessage :: (Ptr CChar -> IO b) -> IO b
allocaErrorMessage :: (Ptr CChar -> IO b) -> IO b
allocaErrorMessage = Int -> (Ptr CChar -> IO b) -> IO b
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256