{-# 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
  { unPlanetNumber :: CInt } deriving (Eq, Show)

newtype GregFlag = GregFlag
  { unGregFlag :: CInt } deriving (Eq, Show)

newtype CalcFlag = CalcFlag
  { unCalcFlag :: CInt } deriving (Eq, Show)

newtype SplitDegFlag = SplitDegFlag
  { unSplitDegFlag :: CInt } deriving (Eq, Show)

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

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

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

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

{-# LINE 58 "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 65 "src/Foreign/SwissEphemeris.hsc" #-}

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

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

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

-- | 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)