swiss-ephemeris-0.2.0.0: Haskell bindings for the Swiss Ephemeris C library

Safe HaskellNone
LanguageHaskell2010

SwissEphemeris

Synopsis

Documentation

data Planet Source #

Instances
Enum Planet Source # 
Instance details

Defined in SwissEphemeris

Eq Planet Source # 
Instance details

Defined in SwissEphemeris

Methods

(==) :: Planet -> Planet -> Bool #

(/=) :: Planet -> Planet -> Bool #

Ord Planet Source # 
Instance details

Defined in SwissEphemeris

Show Planet Source # 
Instance details

Defined in SwissEphemeris

Generic Planet Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep Planet :: Type -> Type #

Methods

from :: Planet -> Rep Planet x #

to :: Rep Planet x -> Planet #

type Rep Planet Source # 
Instance details

Defined in SwissEphemeris

type Rep Planet = D1 (MetaData "Planet" "SwissEphemeris" "swiss-ephemeris-0.2.0.0-FojOtb27jUL7cJU6ugvevj" False) ((((C1 (MetaCons "Sun" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Moon" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "Mercury" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Venus" PrefixI False) (U1 :: Type -> Type))) :+: ((C1 (MetaCons "Mars" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Jupiter" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "Saturn" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Uranus" PrefixI False) (U1 :: Type -> Type)))) :+: (((C1 (MetaCons "Neptune" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Pluto" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "MeanNode" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "TrueNode" PrefixI False) (U1 :: Type -> Type))) :+: ((C1 (MetaCons "MeanApog" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "OscuApog" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "Earth" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Chiron" PrefixI False) (U1 :: Type -> Type)))))

data HouseSystem Source #

Instances
Enum HouseSystem Source # 
Instance details

Defined in SwissEphemeris

Eq HouseSystem Source # 
Instance details

Defined in SwissEphemeris

Ord HouseSystem Source # 
Instance details

Defined in SwissEphemeris

Show HouseSystem Source # 
Instance details

Defined in SwissEphemeris

Generic HouseSystem Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep HouseSystem :: Type -> Type #

type Rep HouseSystem Source # 
Instance details

Defined in SwissEphemeris

type Rep HouseSystem = D1 (MetaData "HouseSystem" "SwissEphemeris" "swiss-ephemeris-0.2.0.0-FojOtb27jUL7cJU6ugvevj" False) ((C1 (MetaCons "Placidus" PrefixI False) (U1 :: Type -> Type) :+: (C1 (MetaCons "Koch" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Porphyrius" PrefixI False) (U1 :: Type -> Type))) :+: ((C1 (MetaCons "Regiomontanus" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "Campanus" PrefixI False) (U1 :: Type -> Type)) :+: (C1 (MetaCons "Equal" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "WholeSign" PrefixI False) (U1 :: Type -> Type))))

data Coordinates Source #

Instances
Eq Coordinates Source # 
Instance details

Defined in SwissEphemeris

Ord Coordinates Source # 
Instance details

Defined in SwissEphemeris

Show Coordinates Source # 
Instance details

Defined in SwissEphemeris

Generic Coordinates Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep Coordinates :: Type -> Type #

type Rep Coordinates Source # 
Instance details

Defined in SwissEphemeris

data HouseCusps Source #

Constructors

HouseCusps 

Fields

Instances
Eq HouseCusps Source # 
Instance details

Defined in SwissEphemeris

Show HouseCusps Source # 
Instance details

Defined in SwissEphemeris

Generic HouseCusps Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep HouseCusps :: Type -> Type #

type Rep HouseCusps Source # 
Instance details

Defined in SwissEphemeris

data Angles Source #

Instances
Eq Angles Source # 
Instance details

Defined in SwissEphemeris

Methods

(==) :: Angles -> Angles -> Bool #

(/=) :: Angles -> Angles -> Bool #

Show Angles Source # 
Instance details

Defined in SwissEphemeris

Generic Angles Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep Angles :: Type -> Type #

Methods

from :: Angles -> Rep Angles x #

to :: Rep Angles x -> Angles #

type Rep Angles Source # 
Instance details

Defined in SwissEphemeris

data CuspsCalculation Source #

Constructors

CuspsCalculation 
Instances
Eq CuspsCalculation Source # 
Instance details

Defined in SwissEphemeris

Show CuspsCalculation Source # 
Instance details

Defined in SwissEphemeris

Generic CuspsCalculation Source # 
Instance details

Defined in SwissEphemeris

Associated Types

type Rep CuspsCalculation :: Type -> Type #

type Rep CuspsCalculation Source # 
Instance details

Defined in SwissEphemeris

type Rep CuspsCalculation = D1 (MetaData "CuspsCalculation" "SwissEphemeris" "swiss-ephemeris-0.2.0.0-FojOtb27jUL7cJU6ugvevj" False) (C1 (MetaCons "CuspsCalculation" PrefixI True) (S1 (MetaSel (Just "houseCusps") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 HouseCusps) :*: S1 (MetaSel (Just "angles") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 Angles)))

defaultCoordinates :: Coordinates Source #

Default coordinates with all zeros -- when you don't care about/know the velocities, which would be the case for most inputs (though most outputs _will_ include them.) Usually you'll set only lat and lng (e.g. `defaultCoordinates{lat = 1.4, lng = 4.1}`) when using it as an input for another function.

setEphemeridesPath :: String -> IO () Source #

Given an *absolute* path, point the underlying ephemerides library to it. Takes a String for easy use with the directory package. 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.

closeEphemerides :: IO () Source #

Explicitly release all "cache" pointers and open files obtained by the C library.

withEphemerides :: FilePath -> IO a -> IO a Source #

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.

julianDay :: Int -> Int -> Int -> Double -> JulianTime Source #

Given year, month and day as Int and a time as Double, return a single floating point number representing absolute Julian Time. The input date is assumed to be in Gregorian time. More info on this: https://www.astro.com/swisseph/swephprg.htm#_Toc46406824

calculateCoordinates :: JulianTime -> Planet -> Either String Coordinates Source #

Given a decimal representation of Julian Time (see julianDay), and a Planet, returns either the position of that planet at the given time, if available in the ephemeris, or an error.

calculateCusps :: JulianTime -> Coordinates -> HouseSystem -> Either String CuspsCalculation Source #

Given a decimal representation of Julian Time (see julianDay), and a set of Coordinates (see calculateCoordinates,) and a HouseSystem (most applications use Placidus,) return either CuspsCalculation with all 12 house cusps in that system, and other relevant Angles, or an error.

calculateCoordinatesM :: MonadFail m => JulianTime -> Planet -> m Coordinates Source #

MonadFail version of calculateCoordinates, in case you don't particularly care about the error message (since it's likely to be due to misconfigured ephe files) and want it to play nice with other MonadFail computations.

calculateCuspsM :: MonadFail m => JulianTime -> Coordinates -> HouseSystem -> m CuspsCalculation Source #

MonadFail version of calculateCusps, in case you don't particularly care about the error message (there's only one error scenario currently: inability to determine cusps, in coordinates not contemplated by the given house system.)