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

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)

-- 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
splitRoundSec :: SplitDegFlag
specialEclNut :: PlanetNumber
specialEclNut  = CInt -> SplitDegFlag
PlanetNumber CInt
(-CInt
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
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   = CInt -> SplitDegFlag
SplitDegFlag CInt
16
splitKeepDeg    :: SplitDegFlag
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

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