-- |
-- Module: SwissEphemeris
-- Description: Bindings to the swisseph C library.
-- License: GPL-2
-- Maintainer: swiss-ephemeris@lfborjas.com
-- Portability: POSIX
--
-- Exposes types and functions that mirror the rich functionality of <https://www.astro.com/swisseph/swephinfo_e.htm Swiss Ephemeris>.
-- Currently only certain bodies are exposed as data constructors, same for the major house systems. This is for the sake of simplicity
-- only, if you need more, please refer to the bundled header files in @csrc@.
--
-- You'll need to procure ephemeris files (see the official site, linked above) if you wish to obtain positions for planets outside of the main planetary
-- bodies in the solar system, or before 3000 B.C or after 3000 A.D. For example, the test suite uses a small ephemeris
-- that includes data for the asteroid Chiron, which is astrologically relevant in most modern practices.
--
-- Currently, only a few select functions that are useful for western horoscopy are exported.
-- There's a wealth of other calculations possible with the underlying library, however,
-- please refer to their documentation and the bundled sources for ideas!
module SwissEphemeris
  ( -- fundamental aliases/newtypes
    JulianTime (..),
    SiderealTime (..),
    HouseCusp,
    -- fundamental enumerations
    SplitDegreesOption (..),
    Planet (..),
    HouseSystem (..),
    ZodiacSignName (..),
    NakshatraName (..),
    -- coordinate/position systems
    EclipticPosition (..),
    EquatorialPosition (..),
    GeographicPosition (..),
    HousePosition (..),
    -- information about the ecliptic at a point in time.
    ObliquityInformation (..),
    Angles (..),
    CuspsCalculation (..),
    LongitudeComponents (..),
    -- management of data files
    setEphemeridesPath,
    setNoEphemeridesPath,
    closeEphemerides,
    withEphemerides,
    withoutEphemerides,
    -- core calculations
    calculateEclipticPosition,
    calculateEquatorialPosition,
    calculateObliquity,
    calculateCusps,
    calculateCuspsLenient,
    calculateCuspsStrict,
    -- utility: coordinate transformation
    equatorialToEcliptic,
    eclipticToEquatorial,
    -- utilities for sidereal information
    calculateSiderealTime,
    calculateSiderealTimeSimple,
    calculateHousePosition,
    calculateHousePositionSimple,
    -- utilities for time calculations:
    julianDay,
    gregorianDateTime,
    deltaTime,
    -- utilities for angles:
    defaultSplitDegreesOptions,
    splitDegrees,
    splitDegreesZodiac,
  )
where

import Control.Exception (bracket_)
import Data.Semigroup ((<>))
import Foreign
import Foreign.C.String
import Foreign.SwissEphemeris
import SwissEphemeris.Internal
import System.IO.Unsafe (unsafePerformIO)

-- | Given a path to a directory, point the underlying ephemerides library to it.
-- You only need to call this function to provide an explicit ephemerides path,
-- if the environment variable @SE_EPHE_PATH@ is set, it overrides this function.
setEphemeridesPath :: FilePath -> IO ()
setEphemeridesPath :: FilePath -> IO ()
setEphemeridesPath FilePath
path =
  FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ephePath -> CString -> IO ()
c_swe_set_ephe_path CString
ephePath

-- | Explicitly state that we don't want to set an ephemeris path,
-- which will default to the built-in ephemeris, or use the directory
-- in the @SE_EPHE_PATH@ environment variable, if set.
setNoEphemeridesPath :: IO ()
setNoEphemeridesPath :: IO ()
setNoEphemeridesPath = CString -> IO ()
c_swe_set_ephe_path CString
forall a. Ptr a
nullPtr

-- | Explicitly release all "cache" pointers and open files obtained by the C
-- library.
closeEphemerides :: IO ()
closeEphemerides :: IO ()
closeEphemerides = IO ()
c_swe_close

-- | Run a computation with a given ephemerides path open, and then close it.
-- Note that the computation does /not/ receive the ephemerides,
-- in keeping with the underlying library's side-effectful conventions.
withEphemerides :: FilePath -> (IO a) -> IO a
withEphemerides :: FilePath -> IO a -> IO a
withEphemerides FilePath
ephemeridesPath =
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (FilePath -> IO ()
setEphemeridesPath FilePath
ephemeridesPath)
    (IO ()
closeEphemerides)

-- | Run a computation with no explicit ephemerides set, if the @SE_EPHE_PATH@
-- environment variable is set, that will be used. If not, it'll fall back to
-- in-memory data.
withoutEphemerides :: (IO a) -> IO a
withoutEphemerides :: IO a -> IO a
withoutEphemerides =
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (IO ()
setNoEphemeridesPath)
    (IO ()
closeEphemerides)

-- | Given year, month and day as `Int` and a time as `Double`, return
-- a single floating point number representing absolute `JulianTime`.
-- The input date is assumed to be in Gregorian time.
julianDay :: Int -> Int -> Int -> Double -> JulianTime
julianDay :: Int -> Int -> Int -> Double -> JulianTime
julianDay Int
year Int
month Int
day Double
hour = Double -> JulianTime
JulianTime (Double -> JulianTime) -> Double -> JulianTime
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Double) -> CDouble -> Double
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 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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

-- | Given a `JulianTime`, return a tuple with a year, month, day
-- and hour (as a `Double`.) It is the reverse of `julianDay`.
gregorianDateTime :: JulianTime -> (Int, Int, Int, Double)
gregorianDateTime :: JulianTime -> (Int, Int, Int, Double)
gregorianDateTime (JulianTime Double
jd) =
  IO (Int, Int, Int, Double) -> (Int, Int, Int, Double)
forall a. IO a -> a
unsafePerformIO (IO (Int, Int, Int, Double) -> (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double) -> (Int, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ do
    (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Double))
 -> IO (Int, Int, Int, Double))
-> (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jyear -> (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Double))
 -> IO (Int, Int, Int, Double))
-> (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jmon -> (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int, Int, Double))
 -> IO (Int, Int, Int, Double))
-> (Ptr CInt -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
jday -> (Ptr CDouble -> IO (Int, Int, Int, Double))
-> IO (Int, Int, Int, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Int, Int, Int, Double))
 -> IO (Int, Int, Int, Double))
-> (Ptr CDouble -> IO (Int, Int, Int, Double))
-> IO (Int, 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
      (Int, Int, Int, Double) -> IO (Int, Int, Int, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int, Int, Double) -> IO (Int, Int, Int, Double))
-> (Int, Int, Int, Double) -> IO (Int, Int, Int, Double)
forall a b. (a -> b) -> a -> b
$ (CInt -> Int
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)

-- | Given `JulianTime` (see `julianDay`),
-- and a `Planet`, returns either the position of that planet at the given time,
-- if available in the ephemeris, or an error. The underlying library may do IO
-- when reading ephemerides data.
calculateEclipticPosition :: JulianTime -> Planet -> IO (Either String EclipticPosition)
calculateEclipticPosition :: JulianTime -> Planet -> IO (Either FilePath EclipticPosition)
calculateEclipticPosition JulianTime
time Planet
planet = do
  let options :: CalcFlag
options = ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
  Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianTime -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianTime
time (Planet -> PlanetNumber
planetNumber Planet
planet)
  Either FilePath EclipticPosition
-> IO (Either FilePath EclipticPosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath EclipticPosition
 -> IO (Either FilePath EclipticPosition))
-> Either FilePath EclipticPosition
-> IO (Either FilePath EclipticPosition)
forall a b. (a -> b) -> a -> b
$ ([Double] -> EclipticPosition)
-> Either FilePath [Double] -> Either FilePath EclipticPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> EclipticPosition
coordinatesFromList Either FilePath [Double]
rawCoords

-- | Obtain equatorial position (includes declination) of a planet.
-- If you've called `calculateEclipticPosition` in your code, this is a very cheap call, as the data
-- is already available to the C code.
calculateEquatorialPosition :: JulianTime -> Planet -> IO (Either String EquatorialPosition)
calculateEquatorialPosition :: JulianTime -> Planet -> IO (Either FilePath EquatorialPosition)
calculateEquatorialPosition JulianTime
time Planet
planet = do
  let options :: CalcFlag
options = ([CalcFlag] -> CalcFlag
mkCalculationOptions ([CalcFlag] -> CalcFlag) -> [CalcFlag] -> CalcFlag
forall a b. (a -> b) -> a -> b
$ [CalcFlag]
defaultCalculationOptions [CalcFlag] -> [CalcFlag] -> [CalcFlag]
forall a. [a] -> [a] -> [a]
++ [CalcFlag
equatorialPositions])
  Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianTime -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianTime
time (Planet -> PlanetNumber
planetNumber Planet
planet)
  Either FilePath EquatorialPosition
-> IO (Either FilePath EquatorialPosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath EquatorialPosition
 -> IO (Either FilePath EquatorialPosition))
-> Either FilePath EquatorialPosition
-> IO (Either FilePath EquatorialPosition)
forall a b. (a -> b) -> a -> b
$ ([Double] -> EquatorialPosition)
-> Either FilePath [Double] -> Either FilePath EquatorialPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> EquatorialPosition
equatorialFromList Either FilePath [Double]
rawCoords

-- | Given a time, calculate ecliptic obliquity and nutation
calculateObliquity :: JulianTime -> IO (Either String ObliquityInformation)
calculateObliquity :: JulianTime -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianTime
time = do
  let options :: CalcFlag
options = CInt -> CalcFlag
CalcFlag CInt
0
  Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianTime -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianTime
time PlanetNumber
specialEclNut
  Either FilePath ObliquityInformation
-> IO (Either FilePath ObliquityInformation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath ObliquityInformation
 -> IO (Either FilePath ObliquityInformation))
-> Either FilePath ObliquityInformation
-> IO (Either FilePath ObliquityInformation)
forall a b. (a -> b) -> a -> b
$ ([Double] -> ObliquityInformation)
-> Either FilePath [Double] -> Either FilePath ObliquityInformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> ObliquityInformation
obliquityNutationFromList Either FilePath [Double]
rawCoords

-- | Internal function for calculations: the contract is too permissive, use one of the specialized
-- ones!
calculateCoordinates' :: CalcFlag -> JulianTime -> PlanetNumber -> IO (Either String [Double])
calculateCoordinates' :: CalcFlag
-> JulianTime -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianTime
time PlanetNumber
planet =
  Int
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
6 ((Ptr CDouble -> IO (Either FilePath [Double]))
 -> IO (Either FilePath [Double]))
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
coords -> Int
-> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((CString -> IO (Either FilePath [Double]))
 -> IO (Either FilePath [Double]))
-> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CalcFlag
iflgret <-
      CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CalcFlag
c_swe_calc_ut
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianTime -> Double) -> JulianTime -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianTime -> Double
unJulianTime (JulianTime -> CDouble) -> JulianTime -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianTime
time)
        PlanetNumber
planet
        CalcFlag
options
        Ptr CDouble
coords
        CString
serr

    if CalcFlag -> CInt
unCalcFlag CalcFlag
iflgret CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
      then do
        FilePath
msg <- CString -> IO FilePath
peekCAString CString
serr
        Either FilePath [Double] -> IO (Either FilePath [Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath [Double]
forall a b. a -> Either a b
Left FilePath
msg
      else do
        [CDouble]
result <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
6 Ptr CDouble
coords
        Either FilePath [Double] -> IO (Either FilePath [Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ [Double] -> Either FilePath [Double]
forall a b. b -> Either a b
Right ([Double] -> Either FilePath [Double])
-> [Double] -> Either FilePath [Double]
forall a b. (a -> b) -> a -> b
$ (CDouble -> Double) -> [CDouble] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac [CDouble]
result

-- | Convert from an ecliptic position to an equatorial position. Requires
-- knowledge of obliquity (see `calculateObliquity`.)
eclipticToEquatorial :: ObliquityInformation -> EclipticPosition -> EquatorialPosition
eclipticToEquatorial :: ObliquityInformation -> EclipticPosition -> EquatorialPosition
eclipticToEquatorial ObliquityInformation
oAndN EclipticPosition
ecliptic =
  let obliquityLn :: Double
obliquityLn = ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
oAndN
      eclipticPos :: [Double]
eclipticPos = EclipticPosition -> [Double]
eclipticToList EclipticPosition
ecliptic
      transformed :: [Double]
transformed = Double -> [Double] -> [Double]
coordinateTransform' (Double -> Double
forall a. Num a => a -> a
negate Double
obliquityLn) [Double]
eclipticPos
   in [Double] -> EquatorialPosition
equatorialFromList [Double]
transformed

-- | Convert from an equatorial position to an ecliptic position. Requires
-- knowledge of obliquity (see `calculateObliquity`.)
equatorialToEcliptic :: ObliquityInformation -> EquatorialPosition -> EclipticPosition
equatorialToEcliptic :: ObliquityInformation -> EquatorialPosition -> EclipticPosition
equatorialToEcliptic ObliquityInformation
oAndN EquatorialPosition
equatorial =
  let obliquityLn :: Double
obliquityLn = ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
oAndN
      equatorialPos :: [Double]
equatorialPos = EquatorialPosition -> [Double]
equatorialToList EquatorialPosition
equatorial
      transformed :: [Double]
transformed = Double -> [Double] -> [Double]
coordinateTransform' Double
obliquityLn [Double]
equatorialPos
   in [Double] -> EclipticPosition
eclipticFromList [Double]
transformed

-- | Internal function for coordinate transformation.
coordinateTransform' :: Double -> [Double] -> [Double]
coordinateTransform' :: Double -> [Double] -> [Double]
coordinateTransform' Double
obliquity [Double]
ins =
  IO [Double] -> [Double]
forall a. IO a -> a
unsafePerformIO (IO [Double] -> [Double]) -> IO [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ do
    [CDouble] -> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Double] -> [CDouble]) -> [Double] -> [CDouble]
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
6 [Double]
ins) ((Ptr CDouble -> IO [Double]) -> IO [Double])
-> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpo -> Int -> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
6 ((Ptr CDouble -> IO [Double]) -> IO [Double])
-> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpn -> do
      ()
_ <- Ptr CDouble -> Ptr CDouble -> CDouble -> IO ()
c_swe_cotrans_sp Ptr CDouble
xpo Ptr CDouble
xpn (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
obliquity)
      [CDouble]
result <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
6 Ptr CDouble
xpn
      [Double] -> IO [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> IO [Double]) -> [Double] -> IO [Double]
forall a b. (a -> b) -> a -> b
$ (CDouble -> Double) -> [CDouble] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac [CDouble]
result

-- | Alias for `calculateCuspsLenient`
calculateCusps :: HouseSystem -> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCusps :: HouseSystem
-> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCusps = HouseSystem
-> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient

-- | Given a decimal representation of Julian Time (see `julianDay`),
-- a `GeographicPosition` and a `HouseSystem`
-- (most applications use `Placidus`,) return a `CuspsCalculation` with all
-- house cusps in that system, and other relevant `Angles`.
-- Notice that certain systems,
-- like `Placidus` and `Koch`, are very likely to fail close to the polar circles; in this
-- and other edge cases, the calculation returns cusps in the `Porphyrius` system.
-- The underlying library may do IO when consulting ephemerides data.
calculateCuspsLenient :: HouseSystem -> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient :: HouseSystem
-> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianTime
time GeographicPosition
loc =
  Int -> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
13 ((Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation)
-> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
cusps -> Int -> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation)
-> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ascmc -> do
    CInt
rval <-
      CDouble
-> CDouble
-> CDouble
-> CInt
-> Ptr CDouble
-> Ptr CDouble
-> IO CInt
c_swe_houses
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianTime -> Double) -> JulianTime -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianTime -> Double
unJulianTime (JulianTime -> CDouble) -> JulianTime -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianTime
time)
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLat GeographicPosition
loc)
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLng GeographicPosition
loc)
        (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ HouseSystem -> Int
toHouseSystemFlag HouseSystem
sys)
        Ptr CDouble
cusps
        Ptr CDouble
ascmc
    -- NOTE: the underlying library returns 13 cusps for most systems,
    -- but the first element is always zero, to enable saying:
    -- cusps[1] -> first house.
    -- we treat it as a normal zero-indexed list.
    -- TODO: the Gauquelin system may return 37 doubles,
    -- we can try to support that, though do keep in mind that it may fall
    -- back to porphyrius near the poles, which ony has 13 doubles returned.
    (CDouble
_ : [CDouble]
cuspsL) <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
13 Ptr CDouble
cusps
    [CDouble]
anglesL <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ascmc
    CuspsCalculation -> IO CuspsCalculation
forall (m :: * -> *) a. Monad m => a -> m a
return (CuspsCalculation -> IO CuspsCalculation)
-> CuspsCalculation -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$
      [Double] -> Angles -> HouseSystem -> CuspsCalculation
CuspsCalculation
        ((CDouble -> Double) -> [CDouble] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([CDouble] -> [Double]) -> [CDouble] -> [Double]
forall a b. (a -> b) -> a -> b
$ [CDouble]
cuspsL)
        ([Double] -> Angles
anglesFromList ([Double] -> Angles) -> [Double] -> Angles
forall a b. (a -> b) -> a -> b
$ (CDouble -> Double) -> [CDouble] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([CDouble] -> [Double]) -> [CDouble] -> [Double]
forall a b. (a -> b) -> a -> b
$ [CDouble]
anglesL)
        (if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then HouseSystem
Porphyrius else HouseSystem
sys)

-- | Unlike `calculateCuspsLenient`, return a `Left` value if the required house system
-- couldn't be used to perform the calculations.
calculateCuspsStrict :: HouseSystem -> JulianTime -> GeographicPosition -> IO (Either String CuspsCalculation)
calculateCuspsStrict :: HouseSystem
-> JulianTime
-> GeographicPosition
-> IO (Either FilePath CuspsCalculation)
calculateCuspsStrict HouseSystem
sys JulianTime
time GeographicPosition
loc = do
  calcs :: CuspsCalculation
calcs@(CuspsCalculation [Double]
_ Angles
_ HouseSystem
sys') <- HouseSystem
-> JulianTime -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianTime
time GeographicPosition
loc
  if HouseSystem
sys' HouseSystem -> HouseSystem -> Bool
forall a. Eq a => a -> a -> Bool
/= HouseSystem
sys
    then Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath CuspsCalculation
 -> IO (Either FilePath CuspsCalculation))
-> Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath CuspsCalculation
forall a b. a -> Either a b
Left (FilePath -> Either FilePath CuspsCalculation)
-> FilePath -> Either FilePath CuspsCalculation
forall a b. (a -> b) -> a -> b
$ FilePath
"Unable to calculate cusps in the requested house system (used " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (HouseSystem -> FilePath
forall a. Show a => a -> FilePath
show HouseSystem
sys') FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" instead.)"
    else Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath CuspsCalculation
 -> IO (Either FilePath CuspsCalculation))
-> Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall a b. (a -> b) -> a -> b
$ CuspsCalculation -> Either FilePath CuspsCalculation
forall a b. b -> Either a b
Right CuspsCalculation
calcs

-- | Calculates the house position of a body in a house in the given system.
-- requires the geographic coordinates and time of the birth/event, and the
-- ecliptic coordinates of the planet/body. You only want this function if
-- you're working in the polar circle, or with objects that are way off the ecliptic;
-- for most objects in usual astrological charts, simply seeing which cusps
-- a planet falls between is sufficient, no need for this more complicated method.
-- see <https://groups.io/g/swisseph/message/4052>
-- NOTES: for the Koch system, this is likely to fail, or return counterintuitive
-- results. Also, we're doing a bit of a funky conversion between sidereal time and
-- ARMC, if you `calculateCusps`, the correct `armc` will be present in the returned `Angles`
calculateHousePositionSimple :: HouseSystem -> JulianTime -> GeographicPosition -> EclipticPosition -> IO (Either String HousePosition)
calculateHousePositionSimple :: HouseSystem
-> JulianTime
-> GeographicPosition
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePositionSimple HouseSystem
sys JulianTime
time GeographicPosition
loc EclipticPosition
pos = do
  Either FilePath ObliquityInformation
obliquityAndNutation <- JulianTime -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianTime
time
  case Either FilePath ObliquityInformation
obliquityAndNutation of
    Left FilePath
e -> Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
 -> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath HousePosition
forall a b. a -> Either a b
Left FilePath
e
    Right ObliquityInformation
on -> do
      SiderealTime Double
siderealTime <- JulianTime -> ObliquityInformation -> IO SiderealTime
calculateSiderealTime JulianTime
time ObliquityInformation
on
      let armc' :: Double
armc' = Double
siderealTime Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
15 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ GeographicPosition -> Double
geoLng GeographicPosition
loc
      HouseSystem
-> Double
-> GeographicPosition
-> ObliquityInformation
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePosition HouseSystem
sys Double
armc' GeographicPosition
loc ObliquityInformation
on EclipticPosition
pos

-- | If you happen to have the correct ARMC for a time and place (obtained from calculateCusps)
-- and obliquity and nutation,
-- you can use this method to calculate a planet's house position.
-- Usually, what you have is just the time and place of the event, and positions of a planet,
-- in those cases, see `calculateHousePositionSimple`.
calculateHousePosition :: HouseSystem -> Double -> GeographicPosition -> ObliquityInformation -> EclipticPosition -> IO (Either String HousePosition)
calculateHousePosition :: HouseSystem
-> Double
-> GeographicPosition
-> ObliquityInformation
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePosition HouseSystem
sys Double
armc' GeographicPosition
geoCoords ObliquityInformation
obliq EclipticPosition
eclipticCoords =
  [CDouble]
-> (Ptr CDouble -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ EclipticPosition -> Double
lng EclipticPosition
eclipticCoords, Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ EclipticPosition -> Double
lat EclipticPosition
eclipticCoords] ((Ptr CDouble -> IO (Either FilePath HousePosition))
 -> IO (Either FilePath HousePosition))
-> (Ptr CDouble -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpin -> Int
-> (CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
256 ((CString -> IO (Either FilePath HousePosition))
 -> IO (Either FilePath HousePosition))
-> (CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CDouble
housePos <-
      CDouble
-> CDouble
-> CDouble
-> CInt
-> Ptr CDouble
-> CString
-> IO CDouble
c_swe_house_pos
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
armc')
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLat GeographicPosition
geoCoords)
        (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
obliq)
        (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ HouseSystem -> Int
toHouseSystemFlag HouseSystem
sys)
        Ptr CDouble
xpin
        CString
serr
    if CDouble
housePos CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
<= CDouble
0
      then do
        FilePath
msg <- CString -> IO FilePath
peekCAString CString
serr
        Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
 -> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath HousePosition
forall a b. a -> Either a b
Left FilePath
msg
      else do
        let houseN :: Int
houseN = CDouble -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate CDouble
housePos
            cuspD :: CDouble
cuspD = CDouble
housePos CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
- (Int -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
houseN)
        Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
 -> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ HousePosition -> Either FilePath HousePosition
forall a b. b -> Either a b
Right (HousePosition -> Either FilePath HousePosition)
-> HousePosition -> Either FilePath HousePosition
forall a b. (a -> b) -> a -> b
$ Int -> Double -> HousePosition
HousePosition Int
houseN (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
cuspD)

-- | Given `JulianTime`, get `SiderealTime`. May consult ephemerides data, hence it being in IO,
-- will have to calculate obliquity at the given julian time, so it'll be slightly slower than
-- `calculateSiderealTime`.
calculateSiderealTimeSimple :: JulianTime -> IO SiderealTime
calculateSiderealTimeSimple :: JulianTime -> IO SiderealTime
calculateSiderealTimeSimple JulianTime
jt = do
  CDouble
sidTime <- CDouble -> IO CDouble
c_swe_sidtime (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianTime -> Double) -> JulianTime -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianTime -> Double
unJulianTime (JulianTime -> CDouble) -> JulianTime -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianTime
jt)
  SiderealTime -> IO SiderealTime
forall (m :: * -> *) a. Monad m => a -> m a
return (SiderealTime -> IO SiderealTime)
-> SiderealTime -> IO SiderealTime
forall a b. (a -> b) -> a -> b
$ Double -> SiderealTime
SiderealTime (Double -> SiderealTime) -> Double -> SiderealTime
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
sidTime

-- | Given a `JulianTime` and `ObliquityInformation`, calculate the equivalent `SiderealTime`.
-- prefer it over `calculateSiderealTimeSimple` if you already obtained `ObliquityInformation`
-- for another calculation.
calculateSiderealTime :: JulianTime -> ObliquityInformation -> IO SiderealTime
calculateSiderealTime :: JulianTime -> ObliquityInformation -> IO SiderealTime
calculateSiderealTime JulianTime
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 -> CDouble)
-> (JulianTime -> Double) -> JulianTime -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianTime -> Double
unJulianTime (JulianTime -> CDouble) -> JulianTime -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianTime
jt) CDouble
obliq CDouble
nut
  SiderealTime -> IO SiderealTime
forall (m :: * -> *) a. Monad m => a -> m a
return (SiderealTime -> IO SiderealTime)
-> SiderealTime -> IO SiderealTime
forall a b. (a -> b) -> a -> b
$ Double -> SiderealTime
SiderealTime (Double -> SiderealTime) -> Double -> SiderealTime
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
sidTime

-- | Given a `JulianTime` (based on a UniversalTime), calculate the delta
-- between it and "true time":
-- See <https://www.astro.com/swisseph/swisseph.htm#_Toc46391727 7. Delta T>
-- It relies on ephemeris data being open, and as such belongs in IO.
-- /NOTE:/ this could be used to create a JulianTime -> EphemerisTime
-- function to send down to @swe_calc@, if we choose to port that one.
deltaTime :: JulianTime -> IO Double
deltaTime :: JulianTime -> IO Double
deltaTime JulianTime
jt = do
  CDouble
deltaT <- CDouble -> IO CDouble
c_swe_deltat (CDouble -> IO CDouble)
-> (JulianTime -> CDouble) -> JulianTime -> IO CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianTime -> Double) -> JulianTime -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianTime -> Double
unJulianTime (JulianTime -> IO CDouble) -> JulianTime -> IO CDouble
forall a b. (a -> b) -> a -> b
$ JulianTime
jt
  Double -> IO Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
deltaT

-- | Given a longitude, return the degrees it's from its nearest sign,
-- minutes, and seconds; with seconds rounded. Convenience alias for `splitDegrees`,
-- when wanting to display e.g. a table in a horoscope.
splitDegreesZodiac :: Double -> LongitudeComponents
splitDegreesZodiac :: Double -> LongitudeComponents
splitDegreesZodiac = [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees ([SplitDegreesOption] -> Double -> LongitudeComponents)
-> [SplitDegreesOption] -> Double -> LongitudeComponents
forall a b. (a -> b) -> a -> b
$ [SplitDegreesOption]
defaultSplitDegreesOptions [SplitDegreesOption]
-> [SplitDegreesOption] -> [SplitDegreesOption]
forall a. Semigroup a => a -> a -> a
<> [SplitDegreesOption
SplitZodiacal, SplitDegreesOption
RoundSeconds]

-- | Given a `Double` representing an ecliptic longitude, split it according to any
-- options from `SplitDegreesOption`:
-- if `SplitZodiacal` or `SplitNakshatra` are specified, they're returned
-- in `longitudeZodiacSign` and `longitudeNakshatra`, respectively.
-- If neither of those is specified, the raw `signum` is then populated, in
-- `longitudeSignum` (-1 for negative, 1, for positive.)
-- /NOTE:/ this function can also be used for latitudes, speeds or quantities
-- from other positional systems (like declinations,) but the zodiacal or
-- nakshatra components would of course be nonsensical.
splitDegrees :: [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees :: [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees [SplitDegreesOption]
options Double
d =
  Maybe ZodiacSignName
-> Integer
-> Integer
-> Integer
-> Double
-> Maybe Int
-> Maybe NakshatraName
-> LongitudeComponents
LongitudeComponents Maybe ZodiacSignName
sign Integer
deg Integer
m Integer
s Double
sf Maybe Int
signum' Maybe NakshatraName
nak
  where
    (Int
z, Integer
deg, Integer
m, Integer
s, Double
sf) = SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' SplitDegFlag
flags Double
d
    flags :: SplitDegFlag
flags = [SplitDegFlag] -> SplitDegFlag
foldSplitDegOptions ([SplitDegFlag] -> SplitDegFlag) -> [SplitDegFlag] -> SplitDegFlag
forall a b. (a -> b) -> a -> b
$ (SplitDegreesOption -> SplitDegFlag)
-> [SplitDegreesOption] -> [SplitDegFlag]
forall a b. (a -> b) -> [a] -> [b]
map SplitDegreesOption -> SplitDegFlag
splitOptionToFlag [SplitDegreesOption]
options
    isZodiacSplit :: Bool
isZodiacSplit = SplitDegreesOption
SplitZodiacal SplitDegreesOption -> [SplitDegreesOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SplitDegreesOption]
options
    isNakshatraSplit :: Bool
isNakshatraSplit = SplitDegreesOption
SplitNakshatra SplitDegreesOption -> [SplitDegreesOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SplitDegreesOption]
options
    sign :: Maybe ZodiacSignName
sign = if Bool
isZodiacSplit then (ZodiacSignName -> Maybe ZodiacSignName
forall a. a -> Maybe a
Just (ZodiacSignName -> Maybe ZodiacSignName)
-> (Int -> ZodiacSignName) -> Int -> Maybe ZodiacSignName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ZodiacSignName
forall a. Enum a => Int -> a
toEnum (Int -> Maybe ZodiacSignName) -> Int -> Maybe ZodiacSignName
forall a b. (a -> b) -> a -> b
$ Int
z) else Maybe ZodiacSignName
forall a. Maybe a
Nothing
    nak :: Maybe NakshatraName
nak = if Bool
isNakshatraSplit then (NakshatraName -> Maybe NakshatraName
forall a. a -> Maybe a
Just (NakshatraName -> Maybe NakshatraName)
-> (Int -> NakshatraName) -> Int -> Maybe NakshatraName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NakshatraName
forall a. Enum a => Int -> a
toEnum (Int -> Maybe NakshatraName) -> Int -> Maybe NakshatraName
forall a b. (a -> b) -> a -> b
$ Int
z) else Maybe NakshatraName
forall a. Maybe a
Nothing
    signum' :: Maybe Int
signum' = if (Bool -> Bool
not Bool
isZodiacSplit Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isNakshatraSplit) then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
z else Maybe Int
forall a. Maybe a
Nothing

-- | Internal implementation to split a given longitude into components.
splitDegrees' :: SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' :: SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' SplitDegFlag
options Double
deg =
  IO (Int, Integer, Integer, Integer, Double)
-> (Int, Integer, Integer, Integer, Double)
forall a. IO a -> a
unsafePerformIO (IO (Int, Integer, Integer, Integer, Double)
 -> (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
-> (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ do
    (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ideg -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
imin -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
isec -> (Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
dsecfr -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
isign -> do
      -- initialize with 0, since it may never be touched.
      Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dsecfr CDouble
0
      ()
_ <-
        CDouble
-> SplitDegFlag
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CDouble
-> Ptr CInt
-> IO ()
c_swe_split_deg
          (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
deg)
          SplitDegFlag
options
          Ptr CInt
ideg
          Ptr CInt
imin
          Ptr CInt
isec
          Ptr CDouble
dsecfr
          Ptr CInt
isign
      CInt
sign' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isign
      CInt
deg' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ideg
      CInt
min' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
imin
      CInt
sec' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isec
      CDouble
secfr <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dsecfr
      (Int, Integer, Integer, Integer, Double)
-> IO (Int, Integer, Integer, Integer, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Integer, Integer, Integer, Double)
 -> IO (Int, Integer, Integer, Integer, Double))
-> (Int, Integer, Integer, Integer, Double)
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ ((CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sign'), (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
deg'), (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
min'), (CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sec'), (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
secfr))