{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
-- |
-- Module: SwissEphemeris
-- Description: Bindings to the swisseph C library.
-- License: AGPL-3
-- 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 thebundled sources for ideas!
module SwissEphemeris
  ( -- * Classes for general concepts
    HasEclipticLongitude(..),
    -- * Fundamental aliases/newtypes
    HouseCusp,
    -- * Fundamental enumerations
    SplitDegreesOption (..),
    Planet (..),
    HouseSystem (..),
    ZodiacSignName (..),
    NakshatraName (..),
    EventSearchDirection(..),
    PlanetMotion(..),
    LunarPhaseName(..),
    -- * Coordinate/position systems
    EclipticPosition (..),
    EquatorialPosition (..),
    GeographicPosition (..),
    HousePosition (..),
    -- * Information about the ecliptic at a point in time
    ObliquityInformation (..),
    Angles (..),
    CuspsCalculation (..),
    LongitudeComponents (..),
    -- * Information about an Eclipse
    SolarEclipseInformation(..),
    SolarEclipseType(..),
    LunarEclipseInformation(..),
    LunarEclipseType(..),
    -- * Management of data files
    setEphemeridesPath,
    setNoEphemeridesPath,
    closeEphemerides,
    withEphemerides,
    withoutEphemerides,
    -- * Core calculations
    calculateEclipticPosition,
    calculateEquatorialPosition,
    calculateObliquity,
    calculateCusps,
    calculateCuspsLenient,
    calculateCuspsStrict,
    -- * Utilities for coordinate transformation
    equatorialToEcliptic,
    eclipticToEquatorial,
    -- * Utilities for sidereal information
    calculateHousePosition,
    calculateHousePositionSimple,
    -- * Utilities for display/splitting
    defaultSplitDegreesOptions,
    splitDegrees,
    splitDegreesZodiac,
    -- * Planetary Phenomena
    planetaryPhenomenon,
    planetaryPhenomenonRaw,
    -- * Crossings over a longitude
    sunCrossing,
    sunCrossingBetween,
    moonCrossing,
    moonCrossingBetween,
    moonCrossingNode,
    heliocentricCrossing,
    crossingBetween,
    -- * Eclipses
    nextSolarEclipse,
    nextSolarEclipseWhen,
    nextSolarEclipseWhere,
    nextLunarEclipse,
    nextLunarEclipseWhen,
    -- * Changes of direction
    directionChangeBetween,
    nextDirectionChange,
    -- * Moon phases
    moonPhaseExactAt,
    module SwissEphemeris.Time
  )
where

import Control.Exception (bracket_)
import Foreign
import Foreign.C.String
import Foreign.SwissEphemeris
import Foreign.Interpolate
import SwissEphemeris.Internal
import System.IO.Unsafe (unsafePerformIO)
import SwissEphemeris.Time
import Foreign.C (CDouble, CInt)
import Data.Bifunctor (second)
import Data.Bool (bool)

-- | 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.
-- 
-- __WARNING__: this is provided for convenience, but in a multi-threaded
-- situation, it is relatively likely that a call to this function will
-- either be optimized away, or interleaved too late. Please consider
-- setting the @SE_EPHE_PATH@ environment variable instead: it will always
-- be found by the C code, vs. the /sometimes/ of Haskell's inscrutable
-- optimizations. For a discussion about the thread-unsafety of
-- this function, see:
-- https://groups.io/g/swisseph/message/10064
-- and the related thread.
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.
-- 
-- __WARNING__: this is provided for convenience, but in a multi-threaded
-- situation, it is relatively likely that a call to this function will
-- either be optimized away, or interleaved too late. Please consider
-- setting the @SE_EPHE_PATH@ environment variable instead: it will always
-- be found by the C code, vs. the /sometimes/ of Haskell's inscrutable
-- optimizations. 
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. You don't need to call this if you always work with the same
-- ephemeris mode: just 'setEphemeridesPath' and walk away -- the OS will
-- clean up any file pointers or static data used by the 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.
--
-- You don't need to call this if you always work with the same
-- ephemeris mode: just 'setEphemeridesPath' and walk away -- the OS will
-- clean up any file pointers or static data used by the library. Preferably,
-- set the @SE_EPHE_PATH@ environment variable. See 'setEphemeridesPath'
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.
--
--- You don't need to call this if you always work with the same
-- ephemeris mode: just 'setEphemeridesPath' and walk away -- the OS will
-- clean up any file pointers or static data used by the library.
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 a 'JulianDay' in 'UT1',
-- 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 :: JulianDayUT1 -> Planet -> IO (Either String EclipticPosition)
calculateEclipticPosition :: JulianDayUT1 -> Planet -> IO (Either FilePath EclipticPosition)
calculateEclipticPosition JulianDayUT1
time Planet
planet = do
  let options :: CalcFlag
options = [CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions
  Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
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 :: JulianDayUT1 -> Planet -> IO (Either String EquatorialPosition)
calculateEquatorialPosition :: JulianDayUT1 -> Planet -> IO (Either FilePath EquatorialPosition)
calculateEquatorialPosition JulianDayUT1
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
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
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 :: JulianDayUT1 -> IO (Either String ObliquityInformation)
calculateObliquity :: JulianDayUT1 -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianDayUT1
time = do
  let options :: CalcFlag
options = CInt -> CalcFlag
CalcFlag CInt
0
  Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
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 -> JulianDayUT1 -> PlanetNumber -> IO (Either String [Double])
calculateCoordinates' :: CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
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 -> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((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)
-> (JulianDayUT1 -> Double) -> JulianDayUT1 -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDayUT1 -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDayUT1 -> CDouble) -> JulianDayUT1 -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDayUT1
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
$
    [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 -> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCusps :: HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCusps = HouseSystem
-> JulianDayUT1 -> 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 -> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient :: HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianDayUT1
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)
-> (JulianDayUT1 -> Double) -> JulianDayUT1 -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDayUT1 -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDayUT1 -> CDouble) -> JulianDayUT1 -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDayUT1
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]
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]
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 -> JulianDayUT1 -> GeographicPosition -> IO (Either String CuspsCalculation)
calculateCuspsStrict :: HouseSystem
-> JulianDayUT1
-> GeographicPosition
-> IO (Either FilePath CuspsCalculation)
calculateCuspsStrict HouseSystem
sys JulianDayUT1
time GeographicPosition
loc = do
  calcs :: CuspsCalculation
calcs@(CuspsCalculation [Double]
_ Angles
_ HouseSystem
sys') <- HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianDayUT1
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 -> JulianDayUT1 -> GeographicPosition -> EclipticPosition -> IO (Either String HousePosition)
calculateHousePositionSimple :: HouseSystem
-> JulianDayUT1
-> GeographicPosition
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePositionSimple HouseSystem
sys JulianDayUT1
time GeographicPosition
loc EclipticPosition
pos = do
  Either FilePath ObliquityInformation
obliquityAndNutation <- JulianDayUT1 -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianDayUT1
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
siderealTime <- JulianDayUT1 -> ObliquityInformation -> IO SiderealTime
julianToSidereal JulianDayUT1
time ObliquityInformation
on
      let armc' :: Double
armc' = SiderealTime -> Double
getSiderealTime SiderealTime
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 -> (CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((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 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. [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
$
    (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 (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)


-------------------------------------------------------------------------------
-- PLANETARY PHENOMENA
-------------------------------------------------------------------------------

-- | Unprocessed vector of data of note for a planetary phenomenon (see 'planetaryPhenomenon')
planetaryPhenomenonRaw :: SingTSI ts =>
  JulianDay ts ->
  PlanetNumber ->
  CalcFlag ->
  IO (Either String [Double])
planetaryPhenomenonRaw :: JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
planetaryPhenomenonRaw = SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
forall (ts :: TimeStandard).
SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
planetaryPhenomenonRaw' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

planetaryPhenomenonRaw' ::
  SingTimeStandard ts ->
  JulianDay ts ->
  PlanetNumber ->
  CalcFlag ->
  IO (Either String [Double])
planetaryPhenomenonRaw' :: SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
planetaryPhenomenonRaw' SingTimeStandard ts
sing JulianDay ts
jd PlanetNumber
ipl CalcFlag
iflag =
  let fn :: CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
      fn :: CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
c_swe_pheno
        SingTimeStandard ts
_ -> CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
c_swe_pheno_ut
  in (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((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 ->
    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
20 ((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
attr -> do
      CInt
rval <-
        CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn
          (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDay ts -> Double) -> JulianDay ts -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDay ts -> CDouble) -> JulianDay ts -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDay ts
jd)
          PlanetNumber
ipl
          CalcFlag
iflag
          Ptr CDouble
attr
          CString
serr

      if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
        then do
          FilePath
err <- CString -> IO FilePath
peekCAString CString
serr
          Either FilePath [Double] -> IO (Either FilePath [Double])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
err
        else do
          [CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
20 Ptr CDouble
attr
          Either FilePath [Double] -> IO (Either FilePath [Double])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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]
attrs

-- | Get a 'PlanetPhenomenon' for a given 'Planet' at a given 'JulianDay'
-- See [8.13. swe_pheno_ut() and swe_pheno(), planetary phenomena](https://www.astro.com/swisseph/swephprg.htm#_Toc78973568)
-- This function is /not/ useful for calculating the phase of the moon, since the phase angle
-- is in the range 0-180 (i.e. can't distinguish between the first/last quarters,) instead,
-- find the angular difference between the positions of the Moon and the Sun at the given time.
planetaryPhenomenon :: SingTSI ts => Planet -> JulianDay ts -> IO (Either String PlanetPhenomenon)
planetaryPhenomenon :: Planet -> JulianDay ts -> IO (Either FilePath PlanetPhenomenon)
planetaryPhenomenon Planet
planet JulianDay ts
jd = do
  let options :: CalcFlag
options = [CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions
  Either FilePath [Double]
pheno <- JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
forall (ts :: TimeStandard).
SingTSI ts =>
JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
planetaryPhenomenonRaw JulianDay ts
jd (Planet -> PlanetNumber
planetNumber Planet
planet) CalcFlag
options
  case Either FilePath [Double]
pheno of
    Left FilePath
err -> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
 -> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath PlanetPhenomenon
forall a b. a -> Either a b
Left FilePath
err
    Right (Double
a:Double
p:Double
e:Double
d:Double
m:[Double]
_) ->
      Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
 -> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ PlanetPhenomenon -> Either FilePath PlanetPhenomenon
forall a b. b -> Either a b
Right (PlanetPhenomenon -> Either FilePath PlanetPhenomenon)
-> PlanetPhenomenon -> Either FilePath PlanetPhenomenon
forall a b. (a -> b) -> a -> b
$
        PlanetPhenomenon :: Double -> Double -> Double -> Double -> Double -> PlanetPhenomenon
PlanetPhenomenon {
         planetPhaseAngle :: Double
planetPhaseAngle = Double
a,
         planetPhase :: Double
planetPhase = Double
p,
         planetElongation :: Double
planetElongation = Double
e,
         planetApparentDiameter :: Double
planetApparentDiameter = Double
d,
         planetApparentMagnitude :: Double
planetApparentMagnitude = Double
m
        }
    Right [Double]
_ -> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
 -> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath PlanetPhenomenon
forall a b. a -> Either a b
Left FilePath
"Unable to calculate all attributes."


-------------------------------------------------------------------------------
-- CROSSINGS
-------------------------------------------------------------------------------

jd2C :: JulianDay s -> CDouble
jd2C :: JulianDay s -> CDouble
jd2C = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDay s -> Double) -> JulianDay s -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay s -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay

dir2C :: EventSearchDirection -> CInt
dir2C :: EventSearchDirection -> CInt
dir2C EventSearchDirection
SearchBackward = -CInt
1
dir2C EventSearchDirection
SearchForward  = CInt
1

sunCrossingOpt
  :: SingTSI ts
  => CalcFlag
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
sunCrossingOpt :: CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossingOpt =
  SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

sunCrossingOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
sunCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jd =
  let fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
      fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross
        SingTimeStandard ts
_   -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_ut
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CDouble
nextCrossing <-
      CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
        CDouble
doubleJD
        CalcFlag
iflag
        CString
serr
    if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
        FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
       | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
       | Bool
otherwise ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)

-- | Given an ecliptic longitude, and 'JulianDay' after which to search
-- try to find the next future date when the Sun will be crossing the
-- given longitude exactly (with a precision of 1 milliarcsecond,)
-- from a geocentric perspective.
sunCrossing :: SingTSI ts
 => Double
 -> JulianDay ts
 -> IO (Either String (JulianDay ts))
sunCrossing :: Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossing = CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

sunCrossingBetweenOpt
  :: SingTSI ts
  => CalcFlag
  -> Double
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
sunCrossingBetweenOpt :: CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt =
  SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

sunCrossingBetweenOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> Double
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
sunCrossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jdStart JulianDay ts
jdEnd =
  let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
      fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_between 
        SingTimeStandard ts
_   -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_ut_between
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart
      defaultErr :: FilePath
defaultErr = FilePath
"No crossing found in the specified interval."
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CDouble
nextCrossing <-
      CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
        CDouble
doubleJD
        (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
        CalcFlag
iflag
        CString
serr
    if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr -> do
        FilePath
libErr <- CString -> IO FilePath
peekCAString CString
serr
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool FilePath
libErr FilePath
defaultErr (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
libErr)
       | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
defaultErr
       | Bool
otherwise ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)

-- | Given an ecliptic longitude, and two 'JulianDay' between which to search
-- try to find intervening time when the Sun will be crossing the
-- given longitude exactly (with a precision of 1 milliarcsecond,)
-- from a geocentric perspective.
sunCrossingBetween :: SingTSI ts
 => Double
 -> JulianDay ts
 -> JulianDay ts
 -> IO (Either String (JulianDay ts))
sunCrossingBetween :: Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetween = CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

moonCrossingOpt
  :: SingTSI ts
  => CalcFlag
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
moonCrossingOpt :: CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossingOpt =
  SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

moonCrossingOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
moonCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jd =
  let fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
      fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross
        SingTimeStandard ts
_   -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_ut
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CDouble
nextCrossing <-
      CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
        CDouble
doubleJD
        CalcFlag
iflag
        CString
serr
    if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
        FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
       | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
       | Bool
otherwise ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)

-- | Given an ecliptic longitude, and 'JulianDay' after which to search
-- try to find the next future date when the Moon will be crossing the
-- given longitude exactly (with a precision of 1 milliarcsecond,)
-- from a geocentric perspective.
moonCrossing :: SingTSI ts
 => Double
 -> JulianDay ts
 -> IO (Either String (JulianDay ts))
moonCrossing :: Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossing = CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

moonCrossingBetweenOpt
  :: SingTSI ts
  => CalcFlag
  -> Double
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
moonCrossingBetweenOpt :: CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt =
  SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

moonCrossingBetweenOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> Double
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
moonCrossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jdStart JulianDay ts
jdEnd =
  let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
      fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_between 
        SingTimeStandard ts
_   -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_ut_between
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart
      defaultErr :: FilePath
defaultErr = FilePath
"No crossing found in the specified interval."
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CDouble
nextCrossing <-
      CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
        CDouble
doubleJD
        (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
        CalcFlag
iflag
        CString
serr
    if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr -> do
        FilePath
libErr <- CString -> IO FilePath
peekCAString CString
serr
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool FilePath
libErr FilePath
defaultErr (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
libErr)
       | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
defaultErr
       | Bool
otherwise ->
        Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
 -> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)

-- | Given an ecliptic longitude, and two 'JulianDay's between which to search
-- try to find the intervening time when the Moon will be crossing the
-- given longitude exactly (with a precision of 1 milliarcsecond,)
-- from a geocentric perspective.
moonCrossingBetween :: SingTSI ts
 => Double
 -> JulianDay ts
 -> JulianDay ts
 -> IO (Either String (JulianDay ts))
moonCrossingBetween :: Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetween = CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

moonCrossingNodeOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> JulianDay ts
  -> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNodeOpt' :: SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt' SingTimeStandard ts
sing CalcFlag
iflag JulianDay ts
jd =
  let fn :: CDouble -> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
      fn :: CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
c_swe_mooncross_node
        SingTimeStandard ts
_   -> CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
c_swe_mooncross_node_ut
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
  in
    (CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
      (Ptr CDouble
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble
  -> IO (Either FilePath (JulianDay ts, Double, Double)))
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (Ptr CDouble
    -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xlon -> (Ptr CDouble
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble
  -> IO (Either FilePath (JulianDay ts, Double, Double)))
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (Ptr CDouble
    -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xlat -> do
        CDouble
nextCrossing <-
          CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
fn
            CDouble
doubleJD
            CalcFlag
iflag
            Ptr CDouble
xlon
            Ptr CDouble
xlat
            CString
serr
        if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
             FilePath -> Either FilePath (JulianDay ts, Double, Double)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, Double, Double))
-> IO FilePath
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
           | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
             Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, Double, Double)
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (FilePath -> Either FilePath (JulianDay ts, Double, Double))
-> FilePath
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts, Double, Double)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> FilePath -> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
           | Bool
otherwise -> do
             CDouble
moonLng <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xlon
             CDouble
moonLat <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xlat
             Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, Double, Double)
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> ((JulianDay ts, Double, Double)
    -> Either FilePath (JulianDay ts, Double, Double))
-> (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, Double, Double)
-> Either FilePath (JulianDay ts, Double, Double)
forall a b. b -> Either a b
Right ((JulianDay ts, Double, Double)
 -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$
              (SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing),
               CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
moonLng,
               CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
moonLat)

moonCrossingNodeOpt :: SingTSI ts => CalcFlag -> JulianDay ts -> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNodeOpt :: CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt = SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

-- | Find the next 'JulianDay' the Moon will cross its True Node, from a /geocentric/
-- perspective.
-- returns the day, and the longitude and latitude of the Moon at that time.
moonCrossingNode :: SingTSI ts
  => JulianDay ts
  -> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNode :: JulianDay ts -> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNode =
  CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

heliocentricCrossingOpt'
  :: SingTimeStandard ts
  -> CalcFlag
  -> EventSearchDirection
  -> Planet
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
heliocentricCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag EventSearchDirection
dir Planet
planet Double
ln JulianDay ts
jd =
  let fn :: PlanetNumber -> CDouble -> CDouble -> CalcFlag -> CInt -> Ptr CDouble -> CString -> IO CInt
      fn :: PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_helio_cross
        SingTimeStandard ts
_ -> PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_helio_cross_ut
      doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
  in
    (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
      (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> do
        CInt
rval <-
          PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
fn
            (Planet -> PlanetNumber
planetNumber Planet
planet)
            (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
            CDouble
doubleJD
            CalcFlag
iflag
            (EventSearchDirection -> CInt
dir2C EventSearchDirection
dir)
            Ptr CDouble
nextCrossingPtr
            CString
serr
        if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
          FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
        else do
          JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr

heliocentricCrossingOpt ::
  SingTSI ts =>
  CalcFlag -> EventSearchDirection -> Planet -> Double -> JulianDay ts -> IO (Either String (JulianDay ts))
heliocentricCrossingOpt :: CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt =
  SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

-- | Find the next 'JulianDay' a given 'Planet' crosses a given ecliptic longitude,
-- notice that this finds /heliocentric/ crossings: due to retrograde motion in most planets,
-- this function is not suitable for geocentric insights. 
-- For example, Mars enters Libra on Sep 5, 2021 from a heliocentric perspective,
-- but won't do so until Sep 14, 2021 from a geocentric perspective.
-- Objects whose orbit is not heliocentric will fail.
heliocentricCrossing
  :: SingTSI ts
  => EventSearchDirection
  -> Planet
  -> Double
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
heliocentricCrossing :: EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossing =
  CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

-------------------------------------------------------------------------------
-- ECLIPSES
-------------------------------------------------------------------------------

{- NOTE(luis)

We currently only have functions to determine when an eclipse is visible from /anywhere/,
but Swiss Ephemeris is also capable of determine /where/ a solar eclipse is visible from,
see the `swe_sol_eclipse_where` function, and the example for more a involved eclipse
calculation routine in 
[8.1.  Example of a typical eclipse calculation](https://www.astro.com/swisseph/swephprg.htm#_Toc78973579)

What we learn from there is that the time when it's maximal is the most important datum
for subsequent calculations.

-}

-- | Various moments of note for a solar eclipse. 
data SolarEclipseInformation = SolarEclipseInformation
  { SolarEclipseInformation -> SolarEclipseType
solarEclipseType :: SolarEclipseType
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseMax :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseNoon :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseBegin :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseEnd :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseTotalityBegin :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseTotalityEnd :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseCenterLineBegin :: JulianDayUT1
  , SolarEclipseInformation -> JulianDayUT1
solarEclipseCenterLineEnd :: JulianDayUT1
  } deriving (SolarEclipseInformation -> SolarEclipseInformation -> Bool
(SolarEclipseInformation -> SolarEclipseInformation -> Bool)
-> (SolarEclipseInformation -> SolarEclipseInformation -> Bool)
-> Eq SolarEclipseInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
$c/= :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
== :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
$c== :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
Eq, Int -> SolarEclipseInformation -> FilePath -> FilePath
[SolarEclipseInformation] -> FilePath -> FilePath
SolarEclipseInformation -> FilePath
(Int -> SolarEclipseInformation -> FilePath -> FilePath)
-> (SolarEclipseInformation -> FilePath)
-> ([SolarEclipseInformation] -> FilePath -> FilePath)
-> Show SolarEclipseInformation
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SolarEclipseInformation] -> FilePath -> FilePath
$cshowList :: [SolarEclipseInformation] -> FilePath -> FilePath
show :: SolarEclipseInformation -> FilePath
$cshow :: SolarEclipseInformation -> FilePath
showsPrec :: Int -> SolarEclipseInformation -> FilePath -> FilePath
$cshowsPrec :: Int -> SolarEclipseInformation -> FilePath -> FilePath
Show)


nextSolarEclipseRaw
  :: CalcFlag
  -> EclipseFlag
  -> Bool
  -> JulianDayUT1
  -> IO (Either String (SolarEclipseType, [Double]))
nextSolarEclipseRaw :: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double]))
nextSolarEclipseRaw CalcFlag
iflag EclipseFlag
ifltype Bool
backward JulianDayUT1
jd =
  (CString -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (SolarEclipseType, [Double])))
 -> IO (Either FilePath (SolarEclipseType, [Double])))
-> (CString -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    Int
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO (Either FilePath (SolarEclipseType, [Double])))
 -> IO (Either FilePath (SolarEclipseType, [Double])))
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ret -> do
      CInt
eclType <-
        CDouble
-> CalcFlag
-> EclipseFlag
-> Ptr CDouble
-> CInt
-> CString
-> IO CInt
c_swe_sol_eclipse_when_glob
          (JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
          CalcFlag
iflag
          EclipseFlag
ifltype
          Ptr CDouble
ret
          (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
backward)
          CString
serr
      if CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (SolarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (SolarEclipseType, [Double]))
-> IO FilePath -> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else do
        [CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ret
        case EclipseFlag -> Maybe SolarEclipseType
eclipseFlagToTypeSolar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
          Maybe SolarEclipseType
Nothing -> 
            Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double])))
-> (FilePath -> Either FilePath (SolarEclipseType, [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (SolarEclipseType, [Double])))
-> FilePath -> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Solar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
          Just SolarEclipseType
set -> 
            Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double])))
-> ((SolarEclipseType, [Double])
    -> Either FilePath (SolarEclipseType, [Double]))
-> (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [Double])
forall a b. b -> Either a b
Right ((SolarEclipseType, [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double])))
-> (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ (SolarEclipseType
set, (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]
attrs)

nextSolarEclipseLocationRaw
  :: CalcFlag
  -> JulianDayUT1
  -> IO (Either String (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw :: CalcFlag
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw CalcFlag
iflag JulianDayUT1
jd =
  (CString
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString
  -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (CString
    -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    Int
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CDouble
  -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
geopos -> Int
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
20 ((Ptr CDouble
  -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (Ptr CDouble
    -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
attr -> do
      CInt
eclType <-
        CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CInt
c_swe_sol_eclipse_where
          (JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
          CalcFlag
iflag
          Ptr CDouble
geopos
          Ptr CDouble
attr
          CString
serr
      if | CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 -> FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
 -> Either FilePath (SolarEclipseType, [Double], [Double]))
-> IO FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
         | CInt
eclType CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 -> Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (FilePath
    -> Either FilePath (SolarEclipseType, [Double], [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"No eclipse occurs at the provided date"
         | Bool
otherwise -> do
           [CDouble]
geo <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CDouble
geopos
           [CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
20 Ptr CDouble
attr
           case EclipseFlag -> Maybe SolarEclipseType
eclipseFlagToTypeSolar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
             Maybe SolarEclipseType
Nothing ->
               Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (FilePath
    -> Either FilePath (SolarEclipseType, [Double], [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Solar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
             Just SolarEclipseType
set ->
               Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> ((SolarEclipseType, [Double], [Double])
    -> Either FilePath (SolarEclipseType, [Double], [Double]))
-> (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType, [Double], [Double])
-> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. b -> Either a b
Right ((SolarEclipseType, [Double], [Double])
 -> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ (SolarEclipseType
set, (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]
geo, (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]
attrs)

nextSolarEclipseLocation
  :: (Either String (SolarEclipseType, [Double], [Double]) -> Either String a)
  -> JulianDayUT1
  -> IO (Either String a)
nextSolarEclipseLocation :: (Either FilePath (SolarEclipseType, [Double], [Double])
 -> Either FilePath a)
-> JulianDayUT1 -> IO (Either FilePath a)
nextSolarEclipseLocation Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a
mkLoc JulianDayUT1
eclDate =
  Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a
mkLoc (Either FilePath (SolarEclipseType, [Double], [Double])
 -> Either FilePath a)
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw CalcFlag
opts JulianDayUT1
eclDate
  where
    opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag       
    
-- | Find the location of the solar eclipse that occurs at the provided
-- 'JulianDay'. You can use 'nextSolarEclipseWhen' to find that date,
-- and then use this function to find a location where it's maximally
-- visible.
nextSolarEclipseWhere
  :: JulianDayUT1
  -> IO (Either String GeographicPosition)
nextSolarEclipseWhere :: JulianDayUT1 -> IO (Either FilePath GeographicPosition)
nextSolarEclipseWhere =
  (Either FilePath (SolarEclipseType, [Double], [Double])
 -> Either FilePath GeographicPosition)
-> JulianDayUT1 -> IO (Either FilePath GeographicPosition)
forall a.
(Either FilePath (SolarEclipseType, [Double], [Double])
 -> Either FilePath a)
-> JulianDayUT1 -> IO (Either FilePath a)
nextSolarEclipseLocation Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath GeographicPosition
forall a c.
Either FilePath (a, [Double], c)
-> Either FilePath GeographicPosition
mkGeo
  where
    mkGeo :: Either FilePath (a, [Double], c)
-> Either FilePath GeographicPosition
mkGeo (Left FilePath
e) = FilePath -> Either FilePath GeographicPosition
forall a b. a -> Either a b
Left FilePath
e
    mkGeo (Right (a
_eclType, Double
ln:Double
lt:[Double]
_, c
_attrs)) =
      GeographicPosition -> Either FilePath GeographicPosition
forall a b. b -> Either a b
Right (GeographicPosition :: Double -> Double -> GeographicPosition
GeographicPosition {geoLng :: Double
geoLng = Double
ln, geoLat :: Double
geoLat = Double
lt})
    mkGeo Either FilePath (a, [Double], c)
_ =
      FilePath -> Either FilePath GeographicPosition
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse location data"

-- | Find the closest solar eclipse to a given date, visible from anywhere on Earth;
-- can be filtered by providing a non-empty list of 'EclipseType' (empty means "any eclipse"), 
-- and one can search backward or forward in time. Bring your own function to convert
-- the array of Doubles returned by the C library into usable data. 
-- See 'nextSolarEclipse' for an example.
nextSolarEclipseBuilder
  :: (Either String (SolarEclipseType, [Double]) -> Either String a)
  -> [SolarEclipseType]
  -> EventSearchDirection
  -> JulianDayUT1
  -> IO (Either String a)
nextSolarEclipseBuilder :: (Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a
mkEcl [SolarEclipseType]
typeFilter EventSearchDirection
dir JulianDayUT1
startDate =
    Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a
mkEcl (Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> IO (Either FilePath (SolarEclipseType, [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double]))
nextSolarEclipseRaw CalcFlag
opts EclipseFlag
eclOpts Bool
backward JulianDayUT1
startDate
   where
    opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag
    eclOpts :: EclipseFlag
eclOpts = 
      if [SolarEclipseType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SolarEclipseType]
typeFilter then
        EclipseFlag
anyEclipse 
      else 
        [EclipseFlag] -> EclipseFlag
foldEclipseOptions ([EclipseFlag] -> EclipseFlag)
-> ([SolarEclipseType] -> [EclipseFlag])
-> [SolarEclipseType]
-> EclipseFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType -> EclipseFlag)
-> [SolarEclipseType] -> [EclipseFlag]
forall a b. (a -> b) -> [a] -> [b]
map SolarEclipseType -> EclipseFlag
solarEclipseTypeToFlag ([SolarEclipseType] -> EclipseFlag)
-> [SolarEclipseType] -> EclipseFlag
forall a b. (a -> b) -> a -> b
$ [SolarEclipseType]
typeFilter
    backward :: Bool
backward =
      case EventSearchDirection
dir of
        EventSearchDirection
SearchBackward -> Bool
True
        EventSearchDirection
SearchForward -> Bool
False

-- | Given filters for a 'SolarEclipseType' (empty means any eclipse,)
-- an 'EventSearchDirection' and a starting 'JulianDay' in 'UT1',
-- find the next (or previous, if searching backward) solar eclipse
-- of the specified type(s). Returns 'SolarEclipseInformation' with all
-- the relevant timestamps of the event.
nextSolarEclipse :: [SolarEclipseType]
  -> EventSearchDirection
  -> JulianDayUT1
  -> IO (Either String SolarEclipseInformation)
nextSolarEclipse :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath SolarEclipseInformation)
nextSolarEclipse =
  (Either FilePath (SolarEclipseType, [Double])
 -> Either FilePath SolarEclipseInformation)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath SolarEclipseInformation)
forall a.
(Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder
   (Either FilePath (SolarEclipseType, [JulianDayUT1])
-> Either FilePath SolarEclipseInformation
mkSolarEcl (Either FilePath (SolarEclipseType, [JulianDayUT1])
 -> Either FilePath SolarEclipseInformation)
-> (Either FilePath (SolarEclipseType, [Double])
    -> Either FilePath (SolarEclipseType, [JulianDayUT1]))
-> Either FilePath (SolarEclipseType, [Double])
-> Either FilePath SolarEclipseInformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SolarEclipseType, [Double])
 -> (SolarEclipseType, [JulianDayUT1]))
-> Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [JulianDayUT1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> [JulianDayUT1])
-> (SolarEclipseType, [Double])
-> (SolarEclipseType, [JulianDayUT1])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1])
-> (Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> a -> b
$ SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1)))
  where
    mkSolarEcl :: Either FilePath (SolarEclipseType, [JulianDayUT1])
-> Either FilePath SolarEclipseInformation
mkSolarEcl (Left FilePath
e) = FilePath -> Either FilePath SolarEclipseInformation
forall a b. a -> Either a b
Left FilePath
e
    mkSolarEcl (Right (SolarEclipseType
typ, JulianDayUT1
a:JulianDayUT1
b:JulianDayUT1
c:JulianDayUT1
d:JulianDayUT1
e:JulianDayUT1
f:JulianDayUT1
g:JulianDayUT1
h:[JulianDayUT1]
_)) =
      SolarEclipseInformation -> Either FilePath SolarEclipseInformation
forall a b. b -> Either a b
Right (SolarEclipseInformation
 -> Either FilePath SolarEclipseInformation)
-> SolarEclipseInformation
-> Either FilePath SolarEclipseInformation
forall a b. (a -> b) -> a -> b
$
        SolarEclipseType
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> SolarEclipseInformation
SolarEclipseInformation
          SolarEclipseType
typ
          JulianDayUT1
a
          JulianDayUT1
b
          JulianDayUT1
c
          JulianDayUT1
d
          JulianDayUT1
e
          JulianDayUT1
f
          JulianDayUT1
g
          JulianDayUT1
h
    mkSolarEcl Either FilePath (SolarEclipseType, [JulianDayUT1])
_ = FilePath -> Either FilePath SolarEclipseInformation
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
    
-- | Find the type and maximum of the closest solar eclipse;
-- useful if you're only interested in the date of the eclipse,
-- and don't care about the more detailed timestamps around the event.
nextSolarEclipseWhen :: [SolarEclipseType]
 -> EventSearchDirection
 -> JulianDayUT1
 -> IO (Either String (SolarEclipseType, JulianDayUT1))
nextSolarEclipseWhen :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, JulianDayUT1))
nextSolarEclipseWhen =
  (Either FilePath (SolarEclipseType, [Double])
 -> Either FilePath (SolarEclipseType, JulianDayUT1))
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, JulianDayUT1))
forall a.
(Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, JulianDayUT1)
forall a.
Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax
  where
    onlyMax :: Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax (Left FilePath
e) = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
e
    onlyMax (Right (a
eclT, Double
jd:[Double]
_)) = (a, JulianDayUT1) -> Either FilePath (a, JulianDayUT1)
forall a b. b -> Either a b
Right (a
eclT, SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1 Double
jd)
    onlyMax Either FilePath (a, [Double])
_ = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
    

-- | Various moments of note for a lunar eclipse. 
data LunarEclipseInformation = LunarEclipseInformation
  { LunarEclipseInformation -> LunarEclipseType
lunarEclipseType :: LunarEclipseType 
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipseMax :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipsePartialPhaseBegin :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipsePartialPhaseEnd :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipseTotalityBegin :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipseTotalityEnd :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipsePenumbralPhaseBegin :: JulianDayUT1
  , LunarEclipseInformation -> JulianDayUT1
lunarEclipsePenumbralPhaseEnd :: JulianDayUT1
  } deriving (LunarEclipseInformation -> LunarEclipseInformation -> Bool
(LunarEclipseInformation -> LunarEclipseInformation -> Bool)
-> (LunarEclipseInformation -> LunarEclipseInformation -> Bool)
-> Eq LunarEclipseInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
$c/= :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
== :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
$c== :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
Eq, Int -> LunarEclipseInformation -> FilePath -> FilePath
[LunarEclipseInformation] -> FilePath -> FilePath
LunarEclipseInformation -> FilePath
(Int -> LunarEclipseInformation -> FilePath -> FilePath)
-> (LunarEclipseInformation -> FilePath)
-> ([LunarEclipseInformation] -> FilePath -> FilePath)
-> Show LunarEclipseInformation
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LunarEclipseInformation] -> FilePath -> FilePath
$cshowList :: [LunarEclipseInformation] -> FilePath -> FilePath
show :: LunarEclipseInformation -> FilePath
$cshow :: LunarEclipseInformation -> FilePath
showsPrec :: Int -> LunarEclipseInformation -> FilePath -> FilePath
$cshowsPrec :: Int -> LunarEclipseInformation -> FilePath -> FilePath
Show)

nextLunarEclipseRaw
  :: CalcFlag
  -> EclipseFlag
  -> Bool
  -> JulianDayUT1
  -> IO (Either String (LunarEclipseType, [Double]))
nextLunarEclipseRaw :: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, [Double]))
nextLunarEclipseRaw CalcFlag
iflag EclipseFlag
ifltype Bool
backward JulianDayUT1
jd =
  (CString -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (LunarEclipseType, [Double])))
 -> IO (Either FilePath (LunarEclipseType, [Double])))
-> (CString -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    Int
-> (Ptr CDouble
    -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO (Either FilePath (LunarEclipseType, [Double])))
 -> IO (Either FilePath (LunarEclipseType, [Double])))
-> (Ptr CDouble
    -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ret -> do
      CInt
eclType <-
        CDouble
-> CalcFlag
-> EclipseFlag
-> Ptr CDouble
-> CInt
-> CString
-> IO CInt
c_swe_lun_eclipse_when
          (JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
          CalcFlag
iflag
          EclipseFlag
ifltype
          Ptr CDouble
ret
          (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
backward)
          CString
serr
      if CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (LunarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (LunarEclipseType, [Double]))
-> IO FilePath -> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else do
        [CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ret
        case EclipseFlag -> Maybe LunarEclipseType
eclipseFlagToTypeLunar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
          Maybe LunarEclipseType
Nothing ->
            Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (LunarEclipseType, [Double])
 -> IO (Either FilePath (LunarEclipseType, [Double])))
-> (FilePath -> Either FilePath (LunarEclipseType, [Double]))
-> FilePath
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (LunarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (LunarEclipseType, [Double])))
-> FilePath -> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Lunar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
          Just LunarEclipseType
set ->
            Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (LunarEclipseType, [Double])
 -> IO (Either FilePath (LunarEclipseType, [Double])))
-> ((LunarEclipseType, [Double])
    -> Either FilePath (LunarEclipseType, [Double]))
-> (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [Double])
forall a b. b -> Either a b
Right ((LunarEclipseType, [Double])
 -> IO (Either FilePath (LunarEclipseType, [Double])))
-> (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ (LunarEclipseType
set, (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]
attrs)

-- | Find the closest solar eclipse to a given date, visible from anywhere on Earth;
-- can be filtered by providing a non-empty list of 'LunarEclipseType' (empty means "any eclipse"), 
-- and one can search backward or forward in time. Bring your own function to convert
-- the array of Doubles returned by the C library into usable data. 
-- See 'nextLunarEclipseSimple' for an example.
nextLunarEclipseBuilder
  :: (Either String (LunarEclipseType, [Double]) -> Either String a)
  -> [LunarEclipseType]
  -> EventSearchDirection
  -> JulianDayUT1
  -> IO (Either String a)
nextLunarEclipseBuilder :: (Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a
mkEcl [LunarEclipseType]
typeFilter EventSearchDirection
dir JulianDayUT1
startDate =
    Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a
mkEcl (Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> IO (Either FilePath (LunarEclipseType, [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, [Double]))
nextLunarEclipseRaw CalcFlag
opts EclipseFlag
eclOpts Bool
backward JulianDayUT1
startDate
   where
    opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag
    eclOpts :: EclipseFlag
eclOpts = 
      if [LunarEclipseType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LunarEclipseType]
typeFilter then 
        EclipseFlag
anyEclipse
      else 
        [EclipseFlag] -> EclipseFlag
foldEclipseOptions ([EclipseFlag] -> EclipseFlag)
-> ([LunarEclipseType] -> [EclipseFlag])
-> [LunarEclipseType]
-> EclipseFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LunarEclipseType -> EclipseFlag)
-> [LunarEclipseType] -> [EclipseFlag]
forall a b. (a -> b) -> [a] -> [b]
map LunarEclipseType -> EclipseFlag
lunarEclipseTypeToFlag ([LunarEclipseType] -> EclipseFlag)
-> [LunarEclipseType] -> EclipseFlag
forall a b. (a -> b) -> a -> b
$ [LunarEclipseType]
typeFilter
    backward :: Bool
backward =
      case EventSearchDirection
dir of
        EventSearchDirection
SearchBackward -> Bool
True
        EventSearchDirection
SearchForward -> Bool
False

-- | Given filters for a 'SolarEclipseType' (empty means any eclipse,)
-- an 'EventSearchDirection' and a starting 'JulianDay' in 'UT1',
-- find the next (or previous, if searching backward) solar eclipse
-- of the specified type(s). Returns 'SolarEclipseInformation' with all
-- the relevant timestamps of the event.
nextLunarEclipse :: [LunarEclipseType]
  -> EventSearchDirection
  -> JulianDayUT1
  -> IO (Either String LunarEclipseInformation)
nextLunarEclipse :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath LunarEclipseInformation)
nextLunarEclipse =
  (Either FilePath (LunarEclipseType, [Double])
 -> Either FilePath LunarEclipseInformation)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath LunarEclipseInformation)
forall a.
(Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder
   (Either FilePath (LunarEclipseType, [JulianDayUT1])
-> Either FilePath LunarEclipseInformation
mkLunarEcl (Either FilePath (LunarEclipseType, [JulianDayUT1])
 -> Either FilePath LunarEclipseInformation)
-> (Either FilePath (LunarEclipseType, [Double])
    -> Either FilePath (LunarEclipseType, [JulianDayUT1]))
-> Either FilePath (LunarEclipseType, [Double])
-> Either FilePath LunarEclipseInformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LunarEclipseType, [Double])
 -> (LunarEclipseType, [JulianDayUT1]))
-> Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [JulianDayUT1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> [JulianDayUT1])
-> (LunarEclipseType, [Double])
-> (LunarEclipseType, [JulianDayUT1])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1])
-> (Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> a -> b
$ SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1)))
  where
    mkLunarEcl :: Either FilePath (LunarEclipseType, [JulianDayUT1])
-> Either FilePath LunarEclipseInformation
mkLunarEcl (Left FilePath
e) = FilePath -> Either FilePath LunarEclipseInformation
forall a b. a -> Either a b
Left FilePath
e
    mkLunarEcl (Right (LunarEclipseType
typ, JulianDayUT1
a:JulianDayUT1
_b:JulianDayUT1
c:JulianDayUT1
d:JulianDayUT1
e:JulianDayUT1
f:JulianDayUT1
g:JulianDayUT1
h:[JulianDayUT1]
_)) =
      LunarEclipseInformation -> Either FilePath LunarEclipseInformation
forall a b. b -> Either a b
Right (LunarEclipseInformation
 -> Either FilePath LunarEclipseInformation)
-> LunarEclipseInformation
-> Either FilePath LunarEclipseInformation
forall a b. (a -> b) -> a -> b
$
        LunarEclipseType
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> LunarEclipseInformation
LunarEclipseInformation
          LunarEclipseType
typ
          JulianDayUT1
a
          JulianDayUT1
c
          JulianDayUT1
d
          JulianDayUT1
e
          JulianDayUT1
f
          JulianDayUT1
g
          JulianDayUT1
h
    mkLunarEcl Either FilePath (LunarEclipseType, [JulianDayUT1])
_ = FilePath -> Either FilePath LunarEclipseInformation
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"

-- | Find the type and maximum of the closest lunar eclipse
nextLunarEclipseWhen :: [LunarEclipseType]
 -> EventSearchDirection
 -> JulianDayUT1
 -> IO (Either String (LunarEclipseType, JulianDayUT1))
nextLunarEclipseWhen :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, JulianDayUT1))
nextLunarEclipseWhen =
  (Either FilePath (LunarEclipseType, [Double])
 -> Either FilePath (LunarEclipseType, JulianDayUT1))
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, JulianDayUT1))
forall a.
(Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, JulianDayUT1)
forall a.
Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax
  where
    onlyMax :: Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax (Left FilePath
e) = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
e
    onlyMax (Right (a
eclT, Double
jd:[Double]
_)) = (a, JulianDayUT1) -> Either FilePath (a, JulianDayUT1)
forall a b. b -> Either a b
Right (a
eclT, SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1 Double
jd)
    onlyMax Either FilePath (a, [Double])
_ = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
 
-------------------------------------------------------------------------------
-- INTERPOLATION
-------------------------------------------------------------------------------

-- | Given two 'JulianDay' moments, determine if a change of direction
-- for a given 'Planet' occurs; and if so, when exactly and what direction
-- it changes to. 
directionChangeBetween
  :: SingTSI ts
  => Planet
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetween :: Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetween =
  CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions )

directionChangeBetweenOpt
  :: SingTSI ts
  => CalcFlag
  -> Planet
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt :: CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt =
  SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

directionChangeBetweenOpt' 
  :: SingTimeStandard ts
  -> CalcFlag 
  -> Planet 
  -> JulianDay ts 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet JulianDay ts
jdStart JulianDay ts
jdEnd =
  let fn :: CDouble -> CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> Ptr CInt -> CString -> IO CInt
      fn :: CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_between
        SingTimeStandard ts
_   -> CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_ut_between
  in (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    (Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CDouble
    -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
dir -> do
      CInt
rval <-
        CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
          (Planet -> PlanetNumber
planetNumber Planet
planet)
          CalcFlag
iflag
          Ptr CDouble
nextCrossingPtr
          Ptr CInt
dir
          CString
serr
      if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, PlanetMotion))
-> IO FilePath -> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else do
        CDouble
nextJD <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
        CInt
nextDir <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dir
        let jd :: JulianDay ts
jd = SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay ts) -> CDouble -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ CDouble
nextJD
            rd :: PlanetMotion
rd = if CInt
nextDir CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then PlanetMotion
RetrogradeMotion else PlanetMotion
DirectMotion
        Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, PlanetMotion)
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> ((JulianDay ts, PlanetMotion)
    -> Either FilePath (JulianDay ts, PlanetMotion))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. b -> Either a b
Right ((JulianDay ts, PlanetMotion)
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ (JulianDay ts
jd, PlanetMotion
rd)

-------------------------------------------------------------------------------

-- | Given a 'Planet' and a 'JulianDay' to start searching, find the next time
-- the Planet changes direction. The search must start at least 30 minutes before
-- the change of direction, and will fail if ephemeris data is not available,
-- or if the body in question doesn't go retrograde within 700 days of the start
-- date (astronomically, this cannot happen for bodies that /do/ present retrograde
-- motion, so it's a reasonable upper bound.)
nextDirectionChange
  :: SingTSI ts
  => Planet
  -> JulianDay ts
  -> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChange :: Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChange =
  CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions )

nextDirectionChangeOpt
  :: SingTSI ts
  => CalcFlag
  -> Planet
  -> JulianDay ts
  -> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt :: CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt =
  SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

nextDirectionChangeOpt' 
  :: SingTimeStandard ts
  -> CalcFlag 
  -> Planet 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet JulianDay ts
jdStart =
  let fn :: CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> Ptr CInt -> CString -> IO CInt
      fn :: CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change
        SingTimeStandard ts
_   -> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_ut
  in (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    (Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CDouble
    -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
dir -> do
      CInt
rval <-
        CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
          (Planet -> PlanetNumber
planetNumber Planet
planet)
          CalcFlag
iflag
          Ptr CDouble
nextCrossingPtr
          Ptr CInt
dir
          CString
serr
      if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, PlanetMotion))
-> IO FilePath -> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else do
        CDouble
nextJD <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
        CInt
nextDir <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dir
        let jd :: JulianDay ts
jd = SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay ts) -> CDouble -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ CDouble
nextJD
            rd :: PlanetMotion
rd = if CInt
nextDir CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then PlanetMotion
RetrogradeMotion else PlanetMotion
DirectMotion
        Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, PlanetMotion)
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> ((JulianDay ts, PlanetMotion)
    -> Either FilePath (JulianDay ts, PlanetMotion))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. b -> Either a b
Right ((JulianDay ts, PlanetMotion)
 -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ (JulianDay ts
jd, PlanetMotion
rd)

-------------------------------------------------------------------------------

-- | Given a @Planet@, a longitude it crosses, and a start and end
-- @JulianDay@s, find the exact moment the planet crosses the given longitude,
-- from a geocentric perspective (retrogrades are taken into account).
-- 
-- _NOTE_: works best when it is known beforehand that the planet crosses
-- the longitude in the given interval, and when the interval is short (e.g. 24 hours): 
-- if the interval is too long the maximum number of iterations to approximate
-- the moment of exactitude may be exceeded. Additionally, if the planet changes
-- direction in the interval and crosses the longitude more than once, only one
-- of the crossings will be found (not necessarily the first one.) You may
-- use 'nextDirectionChange' or 'directionChangeBetween' to subdivide the interval 
-- into sub-intervals that contain one crossing each.
crossingBetween
  :: SingTSI ts
  => Planet
  -> Double
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
crossingBetween :: Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetween =
  CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

crossingBetweenOpt 
  :: SingTSI ts
  => CalcFlag
  -> Planet 
  -> Double 
  -> JulianDay ts 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts))
crossingBetweenOpt :: CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt =
  SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

crossingBetweenOpt' 
  :: SingTimeStandard ts 
  -> CalcFlag 
  -> Planet 
  -> Double 
  -> JulianDay ts 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts))
crossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet Double
lng2Cross JulianDay ts
jdStart JulianDay ts
jdEnd =
  let fn :: PlanetNumber -> CDouble -> CDouble -> CDouble -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
      fn :: PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate
        SingTimeStandard ts
_   -> PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_ut 
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> do
      CInt
rval <-
        PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn
          (Planet -> PlanetNumber
planetNumber Planet
planet)
          (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lng2Cross)
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
          CalcFlag
iflag
          Ptr CDouble
nextCrossingPtr
          CString
serr
      if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else
        JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr

-------------------------------------------------------------------------------


-- | Given start and end moments between which the moon is known to reach a
-- given 'LunarPhaseName', determine the moment of exactitude.
moonPhaseExactAt
  :: SingTSI ts
  => LunarPhaseName
  -> JulianDay ts
  -> JulianDay ts
  -> IO (Either String (JulianDay ts))
moonPhaseExactAt :: LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactAt =
  CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)

moonPhaseExactOpt 
  :: SingTSI ts
  => CalcFlag
  -> LunarPhaseName
  -> JulianDay ts 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts))
moonPhaseExactOpt :: CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt =
  SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS

moonPhaseExactOpt' 
  :: SingTimeStandard ts 
  -> CalcFlag 
  -> LunarPhaseName 
  -> JulianDay ts 
  -> JulianDay ts 
  -> IO (Either String (JulianDay ts))
moonPhaseExactOpt' :: SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt' SingTimeStandard ts
sing CalcFlag
iflag LunarPhaseName
lunarPhase JulianDay ts
jdStart JulianDay ts
jdEnd =
  let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
      fn :: CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
        SingTimeStandard ts
STT -> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_moon_phase
        SingTimeStandard ts
_   -> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_moon_phase_ut
  in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
    (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
 -> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
phaseExactAt -> do
      CInt
rval <-
        CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn
          (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (LunarPhaseName -> Double) -> LunarPhaseName -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LunarPhaseName -> Double
moonPhaseToAngle (LunarPhaseName -> CDouble) -> LunarPhaseName -> CDouble
forall a b. (a -> b) -> a -> b
$ LunarPhaseName
lunarPhase)
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
          (JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
          CalcFlag
iflag
          Ptr CDouble
phaseExactAt
          CString
serr
      if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
        FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
      else
        JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
phaseExactAt