{-# LINE 1 "src/Foreign/SwissEphemeris.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface #-}
{-| 
Module: Foreign.SwissEphemeris
Description: Declarations of bindings to the underlying C library. Import at your own risk!

Exposes very low-level FFI bindings to the C library. Use the @SwissEphemeris@ module and its more
Haskell-friendly exports.
-}


module Foreign.SwissEphemeris where

import Foreign
import Foreign.C.Types
import Foreign.C.String



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

instance Storable PlanetNumber where
  sizeOf :: PlanetNumber -> Int
sizeOf PlanetNumber
_ = CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined::CInt)
  alignment :: PlanetNumber -> Int
alignment  = PlanetNumber -> Int
forall a. Storable a => a -> Int
sizeOf
  peek :: Ptr PlanetNumber -> IO PlanetNumber
peek Ptr PlanetNumber
ptr = do
    CInt
n <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CInt -> IO CInt) -> Ptr CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr PlanetNumber -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr PlanetNumber
ptr
    PlanetNumber -> IO PlanetNumber
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlanetNumber -> IO PlanetNumber)
-> PlanetNumber -> IO PlanetNumber
forall a b. (a -> b) -> a -> b
$ CInt -> PlanetNumber
PlanetNumber CInt
n
  poke :: Ptr PlanetNumber -> PlanetNumber -> IO ()
poke Ptr PlanetNumber
ptr (PlanetNumber CInt
n) =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PlanetNumber -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr PlanetNumber
ptr) CInt
n


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

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

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

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

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

-- following:
-- https://en.wikibooks.org/wiki/Haskell/FFI#Enumerations

sun   :: PlanetNumber
sun :: PlanetNumber
sun   = CInt -> PlanetNumber
PlanetNumber CInt
0
moon  :: PlanetNumber
moon :: PlanetNumber
moon  = CInt -> PlanetNumber
PlanetNumber CInt
1
mercury  :: PlanetNumber
mercury :: PlanetNumber
mercury  = CInt -> PlanetNumber
PlanetNumber CInt
2
venus  :: PlanetNumber
venus :: PlanetNumber
venus  = CInt -> PlanetNumber
PlanetNumber CInt
3
mars  :: PlanetNumber
mars :: PlanetNumber
mars  = CInt -> PlanetNumber
PlanetNumber CInt
4
jupiter  :: PlanetNumber
jupiter :: PlanetNumber
jupiter  = CInt -> PlanetNumber
PlanetNumber CInt
5
saturn  :: PlanetNumber
saturn :: PlanetNumber
saturn  = CInt -> PlanetNumber
PlanetNumber CInt
6
uranus  :: PlanetNumber
uranus :: PlanetNumber
uranus  = CInt -> PlanetNumber
PlanetNumber CInt
7
neptune  :: PlanetNumber
neptune :: PlanetNumber
neptune  = CInt -> PlanetNumber
PlanetNumber CInt
8
pluto  :: PlanetNumber
pluto :: PlanetNumber
pluto  = CInt -> PlanetNumber
PlanetNumber CInt
9
meanNode     :: PlanetNumber
meanNode :: PlanetNumber
meanNode     = CInt -> PlanetNumber
PlanetNumber CInt
10
trueNode  :: PlanetNumber
trueNode :: PlanetNumber
trueNode  = CInt -> PlanetNumber
PlanetNumber CInt
11
meanApog  :: PlanetNumber
meanApog :: PlanetNumber
meanApog  = CInt -> PlanetNumber
PlanetNumber CInt
12
oscuApog  :: PlanetNumber
oscuApog :: PlanetNumber
oscuApog  = CInt -> PlanetNumber
PlanetNumber CInt
13
earth     :: PlanetNumber
earth :: PlanetNumber
earth     = CInt -> PlanetNumber
PlanetNumber CInt
14
chiron  :: PlanetNumber
chiron :: PlanetNumber
chiron  = CInt -> PlanetNumber
PlanetNumber CInt
15
specialEclNut  :: PlanetNumber
specialEclNut :: PlanetNumber
specialEclNut  = CInt -> PlanetNumber
PlanetNumber (-CInt
1)

{-# LINE 69 "src/Foreign/SwissEphemeris.hsc" #-}

julian  :: GregFlag
julian  = GregFlag 0
gregorian  :: GregFlag
gregorian  = GregFlag 1

{-# LINE 74 "src/Foreign/SwissEphemeris.hsc" #-}

-- there are _many_ more, see `swephexp.h:186-215`
speed  :: CalcFlag
speed  = CalcFlag 256
swissEph  :: CalcFlag
swissEph  = CalcFlag 2
equatorialPositions  :: CalcFlag
equatorialPositions  = CalcFlag 2048

{-# LINE 81 "src/Foreign/SwissEphemeris.hsc" #-}

useSwissEph  :: EpheFlag
useSwissEph  = EpheFlag 2
useJplEph    :: EpheFlag
useJplEph    = EpheFlag 1
useMoshierEph  :: EpheFlag
useMoshierEph :: EpheFlag
useMoshierEph  = CInt -> EpheFlag
EpheFlag CInt
4

{-# LINE 87 "src/Foreign/SwissEphemeris.hsc" #-}

splitRoundSec  :: SplitDegFlag
splitRoundSec  = SplitDegFlag 1
splitRoundMin  :: SplitDegFlag
splitRoundMin :: SplitDegFlag
splitRoundMin  = CInt -> SplitDegFlag
SplitDegFlag CInt
2
splitRoundDeg  :: SplitDegFlag
splitRoundDeg :: SplitDegFlag
splitRoundDeg  = CInt -> SplitDegFlag
SplitDegFlag CInt
4
splitZodiacal  :: SplitDegFlag
splitZodiacal :: SplitDegFlag
splitZodiacal  = CInt -> SplitDegFlag
SplitDegFlag CInt
8
splitNakshatra  :: SplitDegFlag
splitNakshatra :: SplitDegFlag
splitNakshatra  = CInt -> SplitDegFlag
SplitDegFlag CInt
1024
splitKeepSign   :: SplitDegFlag
splitKeepSign :: SplitDegFlag
splitKeepSign   = SplitDegFlag CInt
16
splitKeepDeg    :: SplitDegFlag
splitKeepDeg :: SplitDegFlag
splitKeepDeg    = CInt -> SplitDegFlag
SplitDegFlag CInt
32

{-# LINE 97 "src/Foreign/SwissEphemeris.hsc" #-}
 
eclipseCentral  :: EclipseFlag
eclipseCentral  = EclipseFlag 1
eclipseNonCentral  :: EclipseFlag
eclipseNonCentral  = EclipseFlag 2
eclipseTotal  :: EclipseFlag
eclipseTotal  = EclipseFlag 4
eclipseAnnular  :: EclipseFlag
eclipseAnnular :: EclipseFlag
eclipseAnnular  = CInt -> EclipseFlag
EclipseFlag CInt
8
eclipsePartial  :: EclipseFlag
eclipsePartial :: EclipseFlag
eclipsePartial  = CInt -> EclipseFlag
EclipseFlag CInt
16
eclipseAnnularTotal  :: EclipseFlag
eclipseAnnularTotal :: EclipseFlag
eclipseAnnularTotal  = CInt -> EclipseFlag
EclipseFlag CInt
32
eclipseHybrid  :: EclipseFlag
eclipseHybrid :: EclipseFlag
eclipseHybrid  = CInt -> EclipseFlag
EclipseFlag CInt
32
eclipsePenumbral  :: EclipseFlag
eclipsePenumbral :: EclipseFlag
eclipsePenumbral  = CInt -> EclipseFlag
EclipseFlag CInt
64
eclipseSolar  :: EclipseFlag
eclipseSolar :: EclipseFlag
eclipseSolar  = CInt -> EclipseFlag
EclipseFlag CInt
63
eclipseLunar  :: EclipseFlag
eclipseLunar :: EclipseFlag
eclipseLunar  = EclipseFlag 84

{-# LINE 110 "src/Foreign/SwissEphemeris.hsc" #-}

anyEclipse :: EclipseFlag
anyEclipse = EclipseFlag 0

foreign import ccall unsafe "swephexp.h swe_set_ephe_path"
    c_swe_set_ephe_path :: CString -> IO ()

foreign import ccall unsafe "swephexp.h swe_close"
    c_swe_close :: IO ()

foreign import ccall unsafe "swephexp.h swe_julday"
    c_swe_julday :: CInt -- year
                 -> CInt -- month
                 -> CInt -- day 
                 -> CDouble -- hour
                 -> GregFlag
                 -> CDouble

-- | Reverse of `c_swe_julday`: produce a gregorian date
foreign import ccall unsafe "swephexp.h swe_revjul"
    c_swe_revjul :: CDouble
                 -> GregFlag
                 -> Ptr CInt -- year
                 -> Ptr CInt -- month
                 -> Ptr CInt -- day
                 -> Ptr CDouble -- hour
                 -> IO ()


-- | Calculate the position of a body, given a time in
-- Universal Time. Note that this is marginally more expensive than
-- @swe_calc@, but I use this one to keep consistency with @swe_houses@.
foreign import ccall unsafe "swephexp.h swe_calc_ut"
    c_swe_calc_ut :: CDouble
                  -> PlanetNumber
                  -> CalcFlag
                  -> Ptr CDouble
                  -> CString
                  -> (IO CalcFlag)

-- | Get the house cusps and other relevant angles for
-- a given time and place. Note that there's also a
-- @swe_houses_armc@ if one happens to have the ARMC
-- and the ecliptic obliquity handy from other calculations.
foreign import ccall unsafe "swephexp.h swe_houses"
    c_swe_houses :: CDouble -- in fact, a Julian day "Number"
                 -> CDouble -- Lat
                 -> CDouble -- Long
                 -> CInt -- house system (see .hs version of this file)
                 -> Ptr CDouble -- cusps, 13 doubles (or 37 in system G)
                 -> Ptr CDouble -- ascmc, 10 doubles
                 -> (IO CInt)

-- | Calculate the house a planet is in. Takes into account
-- obliquity of the ecliptic. Works for all house systems, 
-- except Koch.
foreign import ccall unsafe "swephexp.h swe_house_pos"
    c_swe_house_pos :: CDouble -- ARMC
                    -> CDouble -- Geographical latitude
                    -> CDouble -- Obliquity
                    -> CInt    -- house system
                    -> Ptr CDouble -- double[2], long/lat of body.
                    -> CString     -- char[256] for errors.
                    -> (IO CDouble)

-- | Low-level function to translate between coordinate systems, with speed position included.
foreign import ccall unsafe "swephexp.h swe_cotrans_sp"
    c_swe_cotrans_sp :: Ptr CDouble -- double[6]: lng, lat, distance
                     -> Ptr CDouble -- double[6]: ascension, declination, distance (or viceversa)
                     -> CDouble     -- obliquity of the ecliptic.
                     -> IO ()

-- | Split a given ecliptic longitude into sign (number)
-- degrees, minutes and seconds.
foreign import ccall unsafe "swephexp.h swe_split_deg"
    c_swe_split_deg :: CDouble -- longitude
                    -> SplitDegFlag -- behavior of rounding/assigning to signs
                    -> Ptr CInt -- degrees
                    -> Ptr CInt -- minutes
                    -> Ptr CInt -- seconds
                    -> Ptr CDouble -- seconds fraction
                    -> Ptr CInt    -- sign/nakshatra
                    -> IO ()       -- returns void.

-- | Calculate the delta time for a given julian time,
-- delta time + julian time = ephemeris time
-- NOTE: there's also @swe_deltat_ex@ which takes an ephemeris
-- flag explicitly, vs. the current global value.
-- my calculations work in one ephemeris, so this one is suitable.
foreign import ccall unsafe "swephexp.h swe_deltat"
    c_swe_deltat :: CDouble -- Julian time
                 -> (IO CDouble)

-- | Calculate the sidereal time for a given julian time.
-- NOTE: there's also @swe_sidtime0@ which requires obliquity
-- and nutation, this one computes them internally.
foreign import ccall unsafe "swephexp.h swe_sidtime"
    c_swe_sidtime :: CDouble -- Julian time
                   -> (IO CDouble)

-- | Calculate the sidereal time for a given julian time, obliquity and nutation.
foreign import ccall unsafe "swephexp.h swe_sidtime0"
    c_swe_sidtime0 :: CDouble -- Julian time
                   -> CDouble -- obliquity
                   -> CDouble -- nutation
                   -> (IO CDouble)

-- | Same as 'c_swe_deltat', but expects one to have explicitly
-- selected an ephemeris mode, and returns a warning if not.
foreign import ccall unsafe "swephexp.h swe_deltat_ex"
    c_swe_deltat_ex :: CDouble
                    -- ^ JulianTime, in a UT scale.
                    -> EpheFlag
                    -- ^ Ephemeris to use (for tidal acceleration data)
                    -> CString
                    -- ^ For warning/error message
                    -> IO CDouble
                    -- ^ Delta T, if the correct ephemeris
                    -- is being used.

{- TODO
  Not added:
 
 * swe_date_conversion (Haskell already has functions for this,
   in the time package)
 * swe_utc_time_zone (expects an offset, in which case the
   ZonedDateTime -> UTCTime conversion in Haskell also suffices.) 
-}

-- | Given a Universal Time input (UTC, but it's considered
-- to be UT1 if before 1971, or if the leap is too great.)
foreign import ccall unsafe "swephexp.h swe_utc_to_jd"
    c_swe_utc_to_jd :: CInt
                    -- ^ year
                    -> CInt
                    -- ^ month
                    -> CInt
                    -- ^ day
                    -> CInt
                    -- ^ hour
                    -> CInt
                    -- ^ min
                    -> CDouble
                    -- ^ sec
                    -> GregFlag
                    -- ^ gregorian/julian
                    -> Ptr CDouble
                    -- ^ @dret[2]@, where pos 0 is 
                    -- the Julian Day in TT (née ET)
                    -- and pos 1 is the Julian Day in UT1
                    -> CString
                    -- ^ error string
                    -> IO CInt
                    -- OK/ERR
                  
foreign import ccall unsafe "swephexp.h swe_jdet_to_utc"
    c_swe_jdet_to_utc :: CDouble
                      -- ^ JD
                      -> GregFlag
                      -- ^ julian/gregorian
                      -> Ptr CInt
                      -- ^ year
                      -> Ptr CInt
                      -- ^ month
                      -> Ptr CInt
                      -- ^ day 
                      -> Ptr CInt
                      -- ^ hour
                      -> Ptr CInt
                      -- ^ min
                      -> Ptr CDouble
                      -- ^ sec
                      -> IO ()
                      
foreign import ccall unsafe "swephexp.h swe_jdut1_to_utc"
    c_swe_jdut1_to_utc :: CDouble
                      -- ^ JD
                      -> GregFlag
                      -- ^ julian/gregorian
                      -> Ptr CInt
                      -- ^ year
                      -> Ptr CInt
                      -- ^ month
                      -> Ptr CInt
                      -- ^ day 
                      -> Ptr CInt
                      -- ^ hour
                      -> Ptr CInt
                      -- ^ min
                      -> Ptr CDouble
                      -- ^ sec
                      -> IO ()

foreign import ccall unsafe "swephexp.h swe_pheno"
    c_swe_pheno :: CDouble
                -- ^ JD (TT)
                -> PlanetNumber
                -- ^ ipl
                -> CalcFlag
                -- ^ iflag
                -> Ptr CDouble
                -- ^ *attr
                -> CString
                -- ^ *serr
                -> IO CInt
                -- ^ retval

foreign import ccall unsafe "swephexp.h swe_pheno_ut"
    c_swe_pheno_ut :: CDouble
                   -- ^ JD (UT)
                   -> PlanetNumber
                   -- ^ ipl
                   -> CalcFlag
                   -- ^ iflag
                   -> Ptr CDouble
                   -- ^ *attr
                   -> CString
                   -- ^ *serr
                   -> IO CInt
                   -- ^ retval

foreign import ccall unsafe "swephexp.h swe_solcross"
  c_swe_solcross :: CDouble
                 -- ^ x2cross -- longitude to cross
                 -> CDouble
                 -- ^ JD (TT)
                 -> CalcFlag
                 -- ^ flag
                 -> CString
                 -- ^ serr
                 -> IO CDouble
                 -- ^ JD (time of next crossing; if in the past, we failed.)

foreign import ccall unsafe "swephexp.h swe_solcross_between"
  c_swe_solcross_between :: CDouble
                         -- ^ x2cross -- longitude to cross
                         -> CDouble
                         -- ^ JD (TT) -- start
                         -> CDouble
                         -- ^ JD (TT) -- end
                         -> CalcFlag
                         -- ^ flag
                         -> CString
                         -- ^ serr
                         -> IO CDouble
                         -- ^ JD (time of next crossing; if in the past, we failed.)


foreign import ccall unsafe "swephexp.h swe_solcross_ut"
  c_swe_solcross_ut :: CDouble
                    -- ^ x2cross -- longitude to cross
                    -> CDouble
                    -- ^ JD (UT1/UT)
                    -> CalcFlag
                    -- ^ flag
                    -> CString
                    -- ^ serr
                    -> IO CDouble
                    -- ^ JD (time of next crossing; if in the past, we failed.)

foreign import ccall unsafe "swephexp.h swe_solcross_ut_between"
  c_swe_solcross_ut_between :: CDouble
                            -- ^ x2cross -- longitude to cross
                            -> CDouble
                            -- ^ JD (UT1/UT) -- start
                            -> CDouble
                            -- ^ JD (UT1/UT) -- end
                            -> CalcFlag
                            -- ^ flag
                            -> CString
                            -- ^ serr
                            -> IO CDouble
                            -- ^ JD (time of next crossing; if in the past, we failed.)


foreign import ccall unsafe "swephexp.h swe_mooncross"
  c_swe_mooncross :: CDouble
                  -- ^ x2cross -- longitude to cross
                  -> CDouble
                  -- ^ JD (TT)
                  -> CalcFlag
                  -- ^ flag
                  -> CString
                  -- ^ serr
                  -> IO CDouble
                  -- ^ JD (time of next crossing; if in the past, we failed.)

foreign import ccall unsafe "swephexp.h swe_mooncross_between"
  c_swe_mooncross_between :: CDouble
                          -- ^ x2cross -- longitude to cross
                          -> CDouble
                          -- ^ JD (TT) -- start
                          -> CDouble
                          -- ^ JD (TT) -- end
                          -> CalcFlag
                          -- ^ flag
                          -> CString
                          -- ^ serr
                          -> IO CDouble
                          -- ^ JD (time of next crossing; if in the past, we failed.)


foreign import ccall unsafe "swephexp.h swe_mooncross_ut"
  c_swe_mooncross_ut :: CDouble
                     -- ^ x2cross -- longitude to cross
                     -> CDouble
                     -- ^ JD (UT1/UT)
                     -> CalcFlag
                     -- ^ flag
                     -> CString
                     -- ^ serr
                     -> IO CDouble
                     -- ^ JD (time of next crossing; if in the past, we failed.)

foreign import ccall unsafe "swephexp.h swe_mooncross_ut_between"
  c_swe_mooncross_ut_between :: CDouble
                             -- ^ x2cross -- longitude to cross
                             -> CDouble
                             -- ^ JD (UT1/UT) -- start
                             -> CDouble
                             -- ^ JD (UT1/UT) -- end
                             -> CalcFlag
                             -- ^ flag
                             -> CString
                             -- ^ serr
                             -> IO CDouble
                             -- ^ JD (time of next crossing; if in the past, we failed.)


foreign import ccall unsafe "swephexp.h swe_mooncross_node"
  c_swe_mooncross_node :: CDouble
                       -- ^ JD (TT)
                       -> CalcFlag
                       -- ^ flag
                       -> Ptr CDouble
                       -- ^ [return] xlon
                       -> Ptr CDouble
                       -- ^ [return] xlat
                       -> CString
                       -- ^ serr
                       -> IO CDouble
                       -- ^ JD (time of next crossing) 

foreign import ccall unsafe "swephexp.h swe_mooncross_node_ut"
  c_swe_mooncross_node_ut :: CDouble
                          -- ^ JD (TT)
                          -> CalcFlag
                          -- ^ flag
                          -> Ptr CDouble
                          -- ^ [return] xlon
                          -> Ptr CDouble
                          -- ^ [return] xlat
                          -> CString
                          -- ^ serr
                          -> IO CDouble
                          -- ^ JD (time of next crossing) 


foreign import ccall unsafe "swephexp.h swe_helio_cross"
  c_swe_helio_cross :: PlanetNumber
                    -- ^ planet
                    -> CDouble
                    -- ^ x2cross
                    -> CDouble
                    -- ^ JD (TT)
                    -> CalcFlag
                    -- ^ iflag
                    -> CInt
                    -- ^ dir (< 0 back, >0 forward)
                    -> Ptr CDouble
                    -- ^ JD
                    -> CString
                    -- ^ serr
                    -> IO CInt
                    -- ^ retval (OK/ERR)

foreign import ccall unsafe "swephexp.h swe_helio_cross_ut"
  c_swe_helio_cross_ut :: PlanetNumber
                       -- ^ planet
                       -> CDouble
                       -- ^ x2cross
                       -> CDouble
                       -- ^ JD (TT)
                       -> CalcFlag
                       -- ^ iflag
                       -> CInt
                       -- ^ dir (< 0 back, >0 forward)
                       -> Ptr CDouble
                       -- ^ JD
                       -> CString
                       -- ^ serr
                       -> IO CInt
                       -- ^ retval (OK/ERR)


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

foreign import ccall unsafe "swephexp.h swe_sol_eclipse_when_glob"
  c_swe_sol_eclipse_when_glob :: CDouble
                              -- ^ JD(UT)
                              -> CalcFlag
                              -- ^ iflag
                              -> EclipseFlag
                              -- ^ ifltype
                              -> Ptr CDouble
                              -- ^ ret[10] eclipse time highlights
                              -> CInt
                              -- ^ BOOL: search backward?
                              -> CString
                              -- ^ serr
                              -> IO CInt
                              -- ^ retval (ERR/Eclipse type)
                              
foreign import ccall unsafe "swephexp.h swe_sol_eclipse_where"
  c_swe_sol_eclipse_where :: CDouble
                          -- ^ JD(UT), must be known time of maximum eclipse
                          -> CalcFlag
                          -- ^ iflag
                          -> Ptr CDouble
                          -- ^ [return] geopos
                          -> Ptr CDouble
                          -- ^ [return] attr
                          -> CString
                          -- ^ serr
                          -> IO CInt
                          -- ^ ret (ERR/eclipse type)
                          
-- | Given a search date, lat/lng/height of a geographic vantage point,
-- return an eclipse's maximum, four contacts and other important events,
-- and various attributes. See:
-- [8.2.  swe_sol_eclipse_when_loc](https://www.astro.com/swisseph/swephprg.htm#_Toc78973580).
-- NOTE(luis) only providing the C binding right now, as I have no /current/ use for all this
-- data, and don't want to provide an opinionated Haskell equivalent until I do. 
foreign import ccall unsafe "swephexp.h swe_sol_eclipse_when_loc"
  c_swe_sol_eclipse_when_loc :: CDouble
                             -- ^ JD(UT), time to start searching
                             -> CalcFlag
                             -- ^ iflag
                             -> Ptr CDouble
                             -- ^ geopos of a known locale
                             -> Ptr CDouble
                             -- ^ [return] tret (contacts)
                             -> Ptr CDouble
                             -- ^ [return] other attributes
                             -> CInt
                             -- ^ BOOL: search backward?
                             -> CString
                             -- ^ serr
                             -> IO CInt
                             -- ^ ret (ERR/eclipse type)
 
foreign import ccall unsafe "swephexp.h swe_lun_eclipse_when"
  c_swe_lun_eclipse_when :: CDouble
                         -- ^ JD(UT)
                         -> CalcFlag
                         -- ^ iflag
                         -> EclipseFlag
                         -- ^ ifltype
                         -> Ptr CDouble
                         -- ^ ret[10] eclipse time highlights
                         -> CInt
                         -- ^ BOOL: forward/backward
                         -> CString
                         -- ^ serr
                         -> IO CInt
                         -- ^ retval (OK/ERR)

-- | Given a search date, lat/lng/height of a geographic vantage point,
-- return an eclipse's maximum, four contacts and other important events,
-- and various attributes. See:
-- [8.9.  swe_lun_eclipse_when_loc](https://www.astro.com/swisseph/swephprg.htm#_Toc78973587).
-- NOTE(luis) only providing the C binding right now, as I have no /current/ use for all this
-- data, and don't want to provide an opinionated Haskell equivalent until I do. 
foreign import ccall unsafe "swephexp.h swe_lun_eclipse_when_loc"
  c_swe_lun_eclipse_when_loc :: CDouble
                             -- ^ JD(UT), time to start searching
                             -> CalcFlag
                             -- ^ iflag
                             -> Ptr CDouble
                             -- ^ geopos of a known locale
                             -> Ptr CDouble
                             -- ^ [return] tret (contacts)
                             -> Ptr CDouble
                             -- ^ [return] other attributes
                             -> CInt
                             -- ^ BOOL: search backward?
                             -> CString
                             -- ^ serr
                             -> IO CInt
                             -- ^ ret (ERR/eclipse type)