{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module: SwissEphemeris.Precalculated
-- License: AGPL-3
-- Maintainer: swiss-ephemeris@lfborjas.com
-- Portability: POSIX
--
-- Functions for interacting with pre-calculated, file-persisted
-- ephemeris. You're responsible for providing a location for
-- @sep4_@ formatted files, as produced by the current version of
-- this library, in a compatible architecture. This can be done either
-- by setting the `EP4_PATH` environment variable to a valid directory path,
-- or via the 'setEph4Path' function.
--
-- @since 1.4.0.0
module SwissEphemeris.Precalculated
  ( -- * About Precalculated Ephemeris
    -- $precalc
    EphemerisPosition (..),
    Ephemeris (..),
    EphemerisBlockNumber,
    EpheVector,

    -- * Options

    -- ** Options for additional computations
    EpheCalcOption (..),

    -- ** Options for which positions to include.
    PlanetListOption (..),

    -- * Convenience functions
    forPlanet,
    planetEphe,
    mkEphemerisBlockNumber,
    extractEphemerisBlockNumber,

    -- * Setup functions
    setEphe4Path,

    -- * High-level read functions
    readEphemeris,
    readEphemerisStrict,
    readEphemerisSimple,
    readEphemerisEasy,

    -- * Low-level read functions
    readEphemerisRaw,
    readEphemerisRawNoFallback,

    -- * Generating new ephemeris files
    writeEphemeris,

    -- * Low-level utils
    foldEpheCalcOptions,
    foldPlanetListOptions,
  )
where

import Data.List (intersect)
import Data.List.NonEmpty (NonEmpty ((:|)), toList)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as VU
import Foreign (Bits ((.|.)), nullPtr, peekArray)
import Foreign.C.String (peekCAString, withCString)
import Foreign.SweEphe4
  ( EpheCalcFlag (..),
    EpheConst (unEpheConst),
    PlacalcPlanet (unPlacalcPlanet),
    PlanetListFlag (..),
    c_dephread2,
    c_ephe4_set_ephe_path,
    c_ephe4_write_file,
    eclipticIndex,
    includeAll,
    includeAllPlanets,
    includeEcliptic,
    includeNutation,
    includeSpeed,
    mustUseStoredEphe,
    numberOfFactors,
    nutationIndex,
    pChiron,
    pJupiter,
    pLilith,
    pMars,
    pMeanNode,
    pMercury,
    pMoon,
    pNeptune,
    pPluto,
    pSaturn,
    pSun,
    pTrueNode,
    pUranus,
    pVenus,
  )
import GHC.Generics (Generic)
import SwissEphemeris.Internal
  (
    Planet
      ( Chiron,
        Jupiter,
        Mars,
        MeanApog,
        MeanNode,
        Mercury,
        Moon,
        Neptune,
        Pluto,
        Saturn,
        Sun,
        TrueNode,
        Uranus,
        Venus
      ),
    allocaErrorMessage, HasEclipticLongitude(..)
  )
import SwissEphemeris.Time

{- $precalc
   Pre-calculated Ephemeris are disk-persisted binary blocks of 10,000 days
   of positions each. They store planetary data in a space-efficient format,
   to the slight detriment of precision. Positions for all planets in the sol
   system (including Pluto, but excluding the heliocentric position of the Earth,)
   as well as the mean lunar apogee ("Black Moon Lilith",) the Mean and True [North]
   lunar nodes, and the asteroid Chiron as well as Ecliptic and Nutation for the day
   are stored in contiguous blocks.

   Even though only midnight data
   is actually stored (e.g. @2440000.5@,) the underlying library will
   use a fast interpolation method to approximate any julian date requested of it,
   it also uses that interpolation method to approximate the speeds of planets,
   which are /not/ stored.
   
   The file format is designed for fast sequential access: a file pointer and
   cursor survive invocations, and a buffer of 20 days of positions is maintained
   in-memory, so requesting all days in a year will benefit vastly from memory
   residency and outpace random access or actual ephemeris calculations. Some
   care has been put into thread-safety, but the original implementation was /not/
   thread safe, so even though I've run a lot of @valgrind@ after adding some
   thread-local guardrails, here may be dragons if you do heavy threaded access
   or heavy non-sequential querying. The regular 'SwissEphemeris' is battle-tested
   for safety and speed, so use that for most use cases that don't need to quickly
   examine large intervals of contiguous time quickly, which is the narrow province
   of this module.
   
   Deferring to the original authors' for more details:

   == /Note from @sweephe4.h@/
   
   The design of ephemeris type ep4:
   In all ASYS and transit application of stored ephemerides
   except Progressed Declinations Type 56 we need only the
   longitudes of the planets or nodes.
   The old EP3 format contains also latitudes, and uses ephemeris time.
   Therefore we define a new ephemeris format, which is capable of
   replacing EP3, when some ASYS programs are changed.
   The ASYS programs requiring different data can receive them
   by asking the calcserv module.
   
   We therefore store now a daily ephemeris with only logitudes, ecl and nut.
   The ephemeris is computed and stored for midnight ephemeris time, i.e.
   for @jd = 2400000.5, 2400001.5@ etc.
   In the ephemeris record for this date, only floor(jd) is kept.
   
   In many cases universal time (UT) is desired, not ephemeris time.
   Because computation with our current computers is very cheap for
   everything except trigonometrci functions, we can afford to
   build a good interpolation into the ephemeris package.
   
   The user can request from ephread() ephemeris positions for
   any (double) jd, not only for midnight ephemeris time.
   Inside the package the same quick Everett 5th-order interpolator
   is used as in placalc.
   It delivers positions within 0.01" for all planets except moon, mercury
   and true node. Moon and Mercury suffer, because their positions are
   stored only with a precision of 0.1"; true node suffers because
   it oscillates quickly with the fastest moon terms.
   The maximum observed differences between placalc and ephread for 12.00 noon
   are 0.25" for moon and true node and 0.1" for Mercury; in 80% of the days
   the differences are less than 0.1". This is significantly better than
   the implemented precision of the placalc package itself.
   
   The Everett interpolator delivers without any additional cost also
   the speed of the planets. This speed is very much better than the
   speed derived for the inner planets from the mean orbits.
   
   The returned data from ephread are in an array of centisec,
   with ecl and nut behind the planets.
   The default, @pflag = 0@, returns all.
   The speeds are returned in the second half of the array;
   the speed is always there, even when the speed bit has not been set.
-}

-- | The ecliptic longitude data of a given 'Planet' 
data EphemerisPosition a = EphemerisPosition
  { EphemerisPosition a -> Planet
ephePlanet :: !Planet,
    -- ^ the 'Planet' this position corresponds to
    EphemerisPosition a -> a
epheLongitude :: !a,
    -- ^ longitude in @a@ units (by default, degrees)
    -- you can use your own @mkEphemeris@-style function;
    -- two are provided here, one to produce 'Double',
    -- another to produce 'Maybe Double'.
    EphemerisPosition a -> a
epheSpeed :: !a
    -- ^ ecliptic speed in @a@ units.
  }
  deriving (EphemerisPosition a -> EphemerisPosition a -> Bool
(EphemerisPosition a -> EphemerisPosition a -> Bool)
-> (EphemerisPosition a -> EphemerisPosition a -> Bool)
-> Eq (EphemerisPosition a)
forall a.
Eq a =>
EphemerisPosition a -> EphemerisPosition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EphemerisPosition a -> EphemerisPosition a -> Bool
$c/= :: forall a.
Eq a =>
EphemerisPosition a -> EphemerisPosition a -> Bool
== :: EphemerisPosition a -> EphemerisPosition a -> Bool
$c== :: forall a.
Eq a =>
EphemerisPosition a -> EphemerisPosition a -> Bool
Eq, Int -> EphemerisPosition a -> ShowS
[EphemerisPosition a] -> ShowS
EphemerisPosition a -> String
(Int -> EphemerisPosition a -> ShowS)
-> (EphemerisPosition a -> String)
-> ([EphemerisPosition a] -> ShowS)
-> Show (EphemerisPosition a)
forall a. Show a => Int -> EphemerisPosition a -> ShowS
forall a. Show a => [EphemerisPosition a] -> ShowS
forall a. Show a => EphemerisPosition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EphemerisPosition a] -> ShowS
$cshowList :: forall a. Show a => [EphemerisPosition a] -> ShowS
show :: EphemerisPosition a -> String
$cshow :: forall a. Show a => EphemerisPosition a -> String
showsPrec :: Int -> EphemerisPosition a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EphemerisPosition a -> ShowS
Show, (forall x. EphemerisPosition a -> Rep (EphemerisPosition a) x)
-> (forall x. Rep (EphemerisPosition a) x -> EphemerisPosition a)
-> Generic (EphemerisPosition a)
forall x. Rep (EphemerisPosition a) x -> EphemerisPosition a
forall x. EphemerisPosition a -> Rep (EphemerisPosition a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (EphemerisPosition a) x -> EphemerisPosition a
forall a x. EphemerisPosition a -> Rep (EphemerisPosition a) x
$cto :: forall a x. Rep (EphemerisPosition a) x -> EphemerisPosition a
$cfrom :: forall a x. EphemerisPosition a -> Rep (EphemerisPosition a) x
Generic)

instance (Real a, Eq a, Fractional a) => HasEclipticLongitude (EphemerisPosition a) where
  getEclipticLongitude :: EphemerisPosition a -> Double
getEclipticLongitude = a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> Double)
-> (EphemerisPosition a -> a) -> EphemerisPosition a -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EphemerisPosition a -> a
forall a. EphemerisPosition a -> a
epheLongitude
  setEclipticLongitude :: EphemerisPosition a -> Double -> EphemerisPosition a
setEclipticLongitude EphemerisPosition a
p Double
l' = EphemerisPosition a
p{epheLongitude :: a
epheLongitude = Double -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
l'}

-- | The positions of all planets for a given time,
-- plus ecliptic and nutation.
data Ephemeris a = Ephemeris
  { Ephemeris a -> JulianDayTT
epheDate :: !JulianDayTT,
    -- ^ julian time for this ephemeris
    Ephemeris a -> a
epheEcliptic :: !a,
    Ephemeris a -> a
epheNutation :: !a,
    Ephemeris a -> Vector (EphemerisPosition a)
ephePositions :: !(V.Vector (EphemerisPosition a))
  }
  deriving (Ephemeris a -> Ephemeris a -> Bool
(Ephemeris a -> Ephemeris a -> Bool)
-> (Ephemeris a -> Ephemeris a -> Bool) -> Eq (Ephemeris a)
forall a. Eq a => Ephemeris a -> Ephemeris a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ephemeris a -> Ephemeris a -> Bool
$c/= :: forall a. Eq a => Ephemeris a -> Ephemeris a -> Bool
== :: Ephemeris a -> Ephemeris a -> Bool
$c== :: forall a. Eq a => Ephemeris a -> Ephemeris a -> Bool
Eq, Int -> Ephemeris a -> ShowS
[Ephemeris a] -> ShowS
Ephemeris a -> String
(Int -> Ephemeris a -> ShowS)
-> (Ephemeris a -> String)
-> ([Ephemeris a] -> ShowS)
-> Show (Ephemeris a)
forall a. Show a => Int -> Ephemeris a -> ShowS
forall a. Show a => [Ephemeris a] -> ShowS
forall a. Show a => Ephemeris a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ephemeris a] -> ShowS
$cshowList :: forall a. Show a => [Ephemeris a] -> ShowS
show :: Ephemeris a -> String
$cshow :: forall a. Show a => Ephemeris a -> String
showsPrec :: Int -> Ephemeris a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ephemeris a -> ShowS
Show, (forall x. Ephemeris a -> Rep (Ephemeris a) x)
-> (forall x. Rep (Ephemeris a) x -> Ephemeris a)
-> Generic (Ephemeris a)
forall x. Rep (Ephemeris a) x -> Ephemeris a
forall x. Ephemeris a -> Rep (Ephemeris a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Ephemeris a) x -> Ephemeris a
forall a x. Ephemeris a -> Rep (Ephemeris a) x
$cto :: forall a x. Rep (Ephemeris a) x -> Ephemeris a
$cfrom :: forall a x. Ephemeris a -> Rep (Ephemeris a) x
Generic)

-- | Options for additional computations that are
-- allowed when reading a block of ephemeris.
data EpheCalcOption
  = IncludeSpeed
  | MustUseStoredEphe
  deriving (EpheCalcOption -> EpheCalcOption -> Bool
(EpheCalcOption -> EpheCalcOption -> Bool)
-> (EpheCalcOption -> EpheCalcOption -> Bool) -> Eq EpheCalcOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EpheCalcOption -> EpheCalcOption -> Bool
$c/= :: EpheCalcOption -> EpheCalcOption -> Bool
== :: EpheCalcOption -> EpheCalcOption -> Bool
$c== :: EpheCalcOption -> EpheCalcOption -> Bool
Eq, Int -> EpheCalcOption -> ShowS
[EpheCalcOption] -> ShowS
EpheCalcOption -> String
(Int -> EpheCalcOption -> ShowS)
-> (EpheCalcOption -> String)
-> ([EpheCalcOption] -> ShowS)
-> Show EpheCalcOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EpheCalcOption] -> ShowS
$cshowList :: [EpheCalcOption] -> ShowS
show :: EpheCalcOption -> String
$cshow :: EpheCalcOption -> String
showsPrec :: Int -> EpheCalcOption -> ShowS
$cshowsPrec :: Int -> EpheCalcOption -> ShowS
Show, Int -> EpheCalcOption
EpheCalcOption -> Int
EpheCalcOption -> [EpheCalcOption]
EpheCalcOption -> EpheCalcOption
EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
EpheCalcOption
-> EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
(EpheCalcOption -> EpheCalcOption)
-> (EpheCalcOption -> EpheCalcOption)
-> (Int -> EpheCalcOption)
-> (EpheCalcOption -> Int)
-> (EpheCalcOption -> [EpheCalcOption])
-> (EpheCalcOption -> EpheCalcOption -> [EpheCalcOption])
-> (EpheCalcOption -> EpheCalcOption -> [EpheCalcOption])
-> (EpheCalcOption
    -> EpheCalcOption -> EpheCalcOption -> [EpheCalcOption])
-> Enum EpheCalcOption
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EpheCalcOption
-> EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
$cenumFromThenTo :: EpheCalcOption
-> EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
enumFromTo :: EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
$cenumFromTo :: EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
enumFromThen :: EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
$cenumFromThen :: EpheCalcOption -> EpheCalcOption -> [EpheCalcOption]
enumFrom :: EpheCalcOption -> [EpheCalcOption]
$cenumFrom :: EpheCalcOption -> [EpheCalcOption]
fromEnum :: EpheCalcOption -> Int
$cfromEnum :: EpheCalcOption -> Int
toEnum :: Int -> EpheCalcOption
$ctoEnum :: Int -> EpheCalcOption
pred :: EpheCalcOption -> EpheCalcOption
$cpred :: EpheCalcOption -> EpheCalcOption
succ :: EpheCalcOption -> EpheCalcOption
$csucc :: EpheCalcOption -> EpheCalcOption
Enum, (forall x. EpheCalcOption -> Rep EpheCalcOption x)
-> (forall x. Rep EpheCalcOption x -> EpheCalcOption)
-> Generic EpheCalcOption
forall x. Rep EpheCalcOption x -> EpheCalcOption
forall x. EpheCalcOption -> Rep EpheCalcOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EpheCalcOption x -> EpheCalcOption
$cfrom :: forall x. EpheCalcOption -> Rep EpheCalcOption x
Generic)

-- | Whether to include all planets, ecliptic, nutation,
-- or all of the above. The underlying library also allows
-- for bit flags to disable selecting some planets; I haven't
-- though of a way to model that ergonomically.
data PlanetListOption
  = IncludeAllPlanets
  | IncludeEcliptic
  | IncludeNutation
  | IncludeAll
  deriving (PlanetListOption -> PlanetListOption -> Bool
(PlanetListOption -> PlanetListOption -> Bool)
-> (PlanetListOption -> PlanetListOption -> Bool)
-> Eq PlanetListOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlanetListOption -> PlanetListOption -> Bool
$c/= :: PlanetListOption -> PlanetListOption -> Bool
== :: PlanetListOption -> PlanetListOption -> Bool
$c== :: PlanetListOption -> PlanetListOption -> Bool
Eq, Int -> PlanetListOption -> ShowS
[PlanetListOption] -> ShowS
PlanetListOption -> String
(Int -> PlanetListOption -> ShowS)
-> (PlanetListOption -> String)
-> ([PlanetListOption] -> ShowS)
-> Show PlanetListOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlanetListOption] -> ShowS
$cshowList :: [PlanetListOption] -> ShowS
show :: PlanetListOption -> String
$cshow :: PlanetListOption -> String
showsPrec :: Int -> PlanetListOption -> ShowS
$cshowsPrec :: Int -> PlanetListOption -> ShowS
Show, Int -> PlanetListOption
PlanetListOption -> Int
PlanetListOption -> [PlanetListOption]
PlanetListOption -> PlanetListOption
PlanetListOption -> PlanetListOption -> [PlanetListOption]
PlanetListOption
-> PlanetListOption -> PlanetListOption -> [PlanetListOption]
(PlanetListOption -> PlanetListOption)
-> (PlanetListOption -> PlanetListOption)
-> (Int -> PlanetListOption)
-> (PlanetListOption -> Int)
-> (PlanetListOption -> [PlanetListOption])
-> (PlanetListOption -> PlanetListOption -> [PlanetListOption])
-> (PlanetListOption -> PlanetListOption -> [PlanetListOption])
-> (PlanetListOption
    -> PlanetListOption -> PlanetListOption -> [PlanetListOption])
-> Enum PlanetListOption
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PlanetListOption
-> PlanetListOption -> PlanetListOption -> [PlanetListOption]
$cenumFromThenTo :: PlanetListOption
-> PlanetListOption -> PlanetListOption -> [PlanetListOption]
enumFromTo :: PlanetListOption -> PlanetListOption -> [PlanetListOption]
$cenumFromTo :: PlanetListOption -> PlanetListOption -> [PlanetListOption]
enumFromThen :: PlanetListOption -> PlanetListOption -> [PlanetListOption]
$cenumFromThen :: PlanetListOption -> PlanetListOption -> [PlanetListOption]
enumFrom :: PlanetListOption -> [PlanetListOption]
$cenumFrom :: PlanetListOption -> [PlanetListOption]
fromEnum :: PlanetListOption -> Int
$cfromEnum :: PlanetListOption -> Int
toEnum :: Int -> PlanetListOption
$ctoEnum :: Int -> PlanetListOption
pred :: PlanetListOption -> PlanetListOption
$cpred :: PlanetListOption -> PlanetListOption
succ :: PlanetListOption -> PlanetListOption
$csucc :: PlanetListOption -> PlanetListOption
Enum, (forall x. PlanetListOption -> Rep PlanetListOption x)
-> (forall x. Rep PlanetListOption x -> PlanetListOption)
-> Generic PlanetListOption
forall x. Rep PlanetListOption x -> PlanetListOption
forall x. PlanetListOption -> Rep PlanetListOption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlanetListOption x -> PlanetListOption
$cfrom :: forall x. PlanetListOption -> Rep PlanetListOption x
Generic)

-- | Up to three-digit numbers assigned to each
-- 10,000 day block of ephemeris data; any given
-- number will be padded with zeroes internally
-- to make up a Julian date, at midnight.
-- e.g. @EphemerisBlocknumber 244@
-- corresponds to @jd = 2440000.5@, i.e.
-- @1968-May-23 12:00:00 UTC@
newtype EphemerisBlockNumber
  = EphemerisBlockNumber Int
  deriving (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
(EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> Eq EphemerisBlockNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c/= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
== :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c== :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
Eq, Int -> EphemerisBlockNumber -> ShowS
[EphemerisBlockNumber] -> ShowS
EphemerisBlockNumber -> String
(Int -> EphemerisBlockNumber -> ShowS)
-> (EphemerisBlockNumber -> String)
-> ([EphemerisBlockNumber] -> ShowS)
-> Show EphemerisBlockNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EphemerisBlockNumber] -> ShowS
$cshowList :: [EphemerisBlockNumber] -> ShowS
show :: EphemerisBlockNumber -> String
$cshow :: EphemerisBlockNumber -> String
showsPrec :: Int -> EphemerisBlockNumber -> ShowS
$cshowsPrec :: Int -> EphemerisBlockNumber -> ShowS
Show, Eq EphemerisBlockNumber
Eq EphemerisBlockNumber
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Ordering)
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> (EphemerisBlockNumber -> EphemerisBlockNumber -> Bool)
-> (EphemerisBlockNumber
    -> EphemerisBlockNumber -> EphemerisBlockNumber)
-> (EphemerisBlockNumber
    -> EphemerisBlockNumber -> EphemerisBlockNumber)
-> Ord EphemerisBlockNumber
EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
EphemerisBlockNumber -> EphemerisBlockNumber -> Ordering
EphemerisBlockNumber
-> EphemerisBlockNumber -> EphemerisBlockNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EphemerisBlockNumber
-> EphemerisBlockNumber -> EphemerisBlockNumber
$cmin :: EphemerisBlockNumber
-> EphemerisBlockNumber -> EphemerisBlockNumber
max :: EphemerisBlockNumber
-> EphemerisBlockNumber -> EphemerisBlockNumber
$cmax :: EphemerisBlockNumber
-> EphemerisBlockNumber -> EphemerisBlockNumber
>= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c>= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
> :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c> :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
<= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c<= :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
< :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
$c< :: EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
compare :: EphemerisBlockNumber -> EphemerisBlockNumber -> Ordering
$ccompare :: EphemerisBlockNumber -> EphemerisBlockNumber -> Ordering
$cp1Ord :: Eq EphemerisBlockNumber
Ord)

-- | The 'Bounded' instance for 'EphemerisBlockNumber' comes from
-- the underlying library's older limits; as reported in the manual:
-- [section 2.1.1 three ephemerides](https://www.astro.com/swisseph/swisseph.htm#_Toc58931065)
-- As of the time of writing, the range was from
-- @JD -3026604.5@ to @JD 7857139.5@ 
-- (i.e. 11 Aug 13000 BCE (-12999) Jul. to 7 Jan 16800 CE Greg.) 
-- However, the underlying C code expects to work in a much smaller range:
-- from @JD -200000.0@ to @JD 3000000.0@, which is "merely"
-- from @6 Jun 5261 BCE@ to @15 Aug 3501 CE@; indicating that pre-calculated
-- ephemeris are more suited for transits/astrology than more serious astronomical
-- studies. I haven't dug into /why/ that limit has been kept other than
-- the fact that it's old code, so it surely is possible to extend it.
instance Bounded EphemerisBlockNumber where
  minBound :: EphemerisBlockNumber
minBound = Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> EphemerisBlockNumber) -> Int -> EphemerisBlockNumber
forall a b. (a -> b) -> a -> b
$ -Int
20
  maxBound :: EphemerisBlockNumber
maxBound = Int -> EphemerisBlockNumber
EphemerisBlockNumber Int
300
  
-- | Implements a lawful 'Bounded' 'Enum'
instance Enum EphemerisBlockNumber where
  succ :: EphemerisBlockNumber -> EphemerisBlockNumber
succ en :: EphemerisBlockNumber
en@(EphemerisBlockNumber Int
n) = 
    if EphemerisBlockNumber
en EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
forall a. Eq a => a -> a -> Bool
== EphemerisBlockNumber
forall a. Bounded a => a
maxBound then 
      String -> EphemerisBlockNumber
forall a. HasCallStack => String -> a
error String
"max bound reached"
    else
      Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> Int
forall a. Enum a => a -> a
succ Int
n)
  pred :: EphemerisBlockNumber -> EphemerisBlockNumber
pred en :: EphemerisBlockNumber
en@(EphemerisBlockNumber Int
n) = 
    if EphemerisBlockNumber
en EphemerisBlockNumber -> EphemerisBlockNumber -> Bool
forall a. Eq a => a -> a -> Bool
== EphemerisBlockNumber
forall a. Bounded a => a
minBound  then
      String -> EphemerisBlockNumber
forall a. HasCallStack => String -> a
error String
"min bound reached"
    else
      Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> Int
forall a. Enum a => a -> a
pred Int
n)
  toEnum :: Int -> EphemerisBlockNumber
toEnum = Int -> EphemerisBlockNumber
EphemerisBlockNumber
  fromEnum :: EphemerisBlockNumber -> Int
fromEnum (EphemerisBlockNumber Int
n) = Int
n
  enumFrom :: EphemerisBlockNumber -> [EphemerisBlockNumber]
enumFrom EphemerisBlockNumber
x = EphemerisBlockNumber
-> EphemerisBlockNumber -> [EphemerisBlockNumber]
forall a. Enum a => a -> a -> [a]
enumFromTo EphemerisBlockNumber
x EphemerisBlockNumber
forall a. Bounded a => a
maxBound
  enumFromThen :: EphemerisBlockNumber
-> EphemerisBlockNumber -> [EphemerisBlockNumber]
enumFromThen EphemerisBlockNumber
x EphemerisBlockNumber
y = EphemerisBlockNumber
-> EphemerisBlockNumber
-> EphemerisBlockNumber
-> [EphemerisBlockNumber]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo EphemerisBlockNumber
x EphemerisBlockNumber
y EphemerisBlockNumber
forall a. Bounded a => a
maxBound
  enumFromTo :: EphemerisBlockNumber
-> EphemerisBlockNumber -> [EphemerisBlockNumber]
enumFromTo (EphemerisBlockNumber Int
n) (EphemerisBlockNumber Int
m) =
    (Int -> EphemerisBlockNumber) -> [Int] -> [EphemerisBlockNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> Int -> [Int]
forall a. Enum a => a -> a -> [a]
enumFromTo Int
n Int
m)
  enumFromThenTo :: EphemerisBlockNumber
-> EphemerisBlockNumber
-> EphemerisBlockNumber
-> [EphemerisBlockNumber]
enumFromThenTo (EphemerisBlockNumber Int
n) (EphemerisBlockNumber Int
n') (EphemerisBlockNumber Int
m) =
    (Int -> EphemerisBlockNumber) -> [Int] -> [EphemerisBlockNumber]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> Int -> Int -> [Int]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Int
n Int
n' Int
m)
  

-- | Construct a valid ephemeris block number. As per the
-- underlying library, all times between Julian day @-200000.0@
-- and @3000000.0@ are valid. Note that depending on which
-- ephemeris files you have, your effective range may be smaller,
-- or bigger. This is provided as a common denominator, but to get
-- the /real/ range of your ephemeris, check out the @swe_get_current_file_data@
-- function. 
-- (cf. [section 2.6 of the manual](https://www.astro.com/swisseph/swephprg.htm#_Toc71121146))
mkEphemerisBlockNumber :: Int -> Maybe EphemerisBlockNumber
mkEphemerisBlockNumber :: Int -> Maybe EphemerisBlockNumber
mkEphemerisBlockNumber Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> EphemerisBlockNumber -> Int
extractEphemerisBlockNumber EphemerisBlockNumber
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< EphemerisBlockNumber -> Int
extractEphemerisBlockNumber EphemerisBlockNumber
forall a. Bounded a => a
maxBound = EphemerisBlockNumber -> Maybe EphemerisBlockNumber
forall a. a -> Maybe a
Just (EphemerisBlockNumber -> Maybe EphemerisBlockNumber)
-> (Int -> EphemerisBlockNumber)
-> Int
-> Maybe EphemerisBlockNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> EphemerisBlockNumber
EphemerisBlockNumber (Int -> Maybe EphemerisBlockNumber)
-> Int -> Maybe EphemerisBlockNumber
forall a b. (a -> b) -> a -> b
$ Int
n
  | Bool
otherwise = Maybe EphemerisBlockNumber
forall a. Maybe a
Nothing

-- | Get the 'Int' inside an 'EphemerisBlockNumber'
extractEphemerisBlockNumber :: EphemerisBlockNumber -> Int
extractEphemerisBlockNumber :: EphemerisBlockNumber -> Int
extractEphemerisBlockNumber (EphemerisBlockNumber Int
n) = Int
n

-- | For extreme data locality, we schlep around unboxed vectors.
-- Note that the higher level functions return regular 'Vector's,
-- to maintain some locality/performance, without awkward unboxing.
type EpheVector = VU.Vector Double

-- | Convenience "indexing" function to get a given 'Planet's
-- data from a given ephemeris.
forPlanet :: Ephemeris a -> Planet -> Maybe (EphemerisPosition a)
forPlanet :: Ephemeris a -> Planet -> Maybe (EphemerisPosition a)
forPlanet Ephemeris a
ephe Planet
pl =
  case Planet -> Maybe PlacalcPlanet
planetToPlanetOption Planet
pl of
    Maybe PlacalcPlanet
Nothing -> Maybe (EphemerisPosition a)
forall a. Maybe a
Nothing
    Just PlacalcPlanet
placalc -> Ephemeris a -> Vector (EphemerisPosition a)
forall a. Ephemeris a -> Vector (EphemerisPosition a)
ephePositions Ephemeris a
ephe Vector (EphemerisPosition a) -> Int -> Maybe (EphemerisPosition a)
forall a. Vector a -> Int -> Maybe a
V.!? (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (PlacalcPlanet -> CInt) -> PlacalcPlanet -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlacalcPlanet -> CInt
unPlacalcPlanet (PlacalcPlanet -> Int) -> PlacalcPlanet -> Int
forall a b. (a -> b) -> a -> b
$ PlacalcPlanet
placalc)
    
-- | Flipped version of `forPlanet`
planetEphe :: Planet -> Ephemeris a -> Maybe (EphemerisPosition a)
planetEphe :: Planet -> Ephemeris a -> Maybe (EphemerisPosition a)
planetEphe = (Ephemeris a -> Planet -> Maybe (EphemerisPosition a))
-> Planet -> Ephemeris a -> Maybe (EphemerisPosition a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ephemeris a -> Planet -> Maybe (EphemerisPosition a)
forall a. Ephemeris a -> Planet -> Maybe (EphemerisPosition a)
forPlanet

-- | Set path for base directory where @sep4_@ files are stored.
-- 
-- __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 @EP4_PATH@ environment variable instead: it will always
-- be found by the C code, vs. the /sometimes/ of Haskell's inscrutable
-- optimizations.
setEphe4Path :: FilePath -> IO ()
setEphe4Path :: String -> IO ()
setEphe4Path String
path =
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
baseEphe4Path -> CString -> IO ()
c_ephe4_set_ephe_path CString
baseEphe4Path

-- | Given a function to convert a vector of doubles to a type for ephemeris,
-- a list of 'PlanetListOption', a list of 'EpheCalcOption' and a 'JulianDay',
-- try to get ephemeris data from a precalculated file on disk, or, if
-- allowed in the specified options, fall back to regular Swiss
-- Ephemeris calculations, using the current ephemeris mode.
--
-- The authors of Swiss Ephemeris encourage always requesting all
-- planets, ecliptic and nutation since they're stored in contiguous blocks anyway,
-- and the implementation calculates speeds /always/ so omitting speed
-- isn't worthwhile apart from data hygiene, or when choosing to allow
-- falling back to non-stored calculations.
--
-- Make sure you set the @EP4_PATH@ environment variable, or call
-- 'setEphe4Path' before calling this function, otherwise the
-- underlying library will try to locate the files in @/home/ephe/@.
readEphemeris ::
  ( NonEmpty PlanetListOption ->
    NonEmpty EpheCalcOption ->
    JulianDayTT  ->
    EpheVector ->
    a
  ) ->
  NonEmpty PlanetListOption ->
  NonEmpty EpheCalcOption ->
  JulianDayTT  ->
  IO (Either String a)
readEphemeris :: (NonEmpty PlanetListOption
 -> NonEmpty EpheCalcOption -> JulianDayTT -> EpheVector -> a)
-> NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String a)
readEphemeris NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption -> JulianDayTT -> EpheVector -> a
mkEphemeris NonEmpty PlanetListOption
planetOptions NonEmpty EpheCalcOption
calcOptions JulianDayTT
time = do
  -- TODO(luis,) technically, we're /also/ able to exclude
  -- planets from calculations; don't currently have a use for that,
  -- but there should be a clean way to do that... or maybe we'll
  -- literally have to include all planets in 'PlanetListOption'.
  let plalist :: PlanetListFlag
plalist =
        [PlanetListFlag] -> PlanetListFlag
foldPlanetListOptions
          ([PlanetListFlag] -> PlanetListFlag)
-> (NonEmpty PlanetListOption -> [PlanetListFlag])
-> NonEmpty PlanetListOption
-> PlanetListFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlanetListOption -> PlanetListFlag)
-> [PlanetListOption] -> [PlanetListFlag]
forall a b. (a -> b) -> [a] -> [b]
map PlanetListOption -> PlanetListFlag
planetListOptionToFlag
          ([PlanetListOption] -> [PlanetListFlag])
-> (NonEmpty PlanetListOption -> [PlanetListOption])
-> NonEmpty PlanetListOption
-> [PlanetListFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PlanetListOption -> [PlanetListOption]
forall a. NonEmpty a -> [a]
toList
          (NonEmpty PlanetListOption -> PlanetListFlag)
-> NonEmpty PlanetListOption -> PlanetListFlag
forall a b. (a -> b) -> a -> b
$ NonEmpty PlanetListOption
planetOptions
      flag :: EpheCalcFlag
flag =
        [EpheCalcFlag] -> EpheCalcFlag
foldEpheCalcOptions
          ([EpheCalcFlag] -> EpheCalcFlag)
-> (NonEmpty EpheCalcOption -> [EpheCalcFlag])
-> NonEmpty EpheCalcOption
-> EpheCalcFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpheCalcOption -> EpheCalcFlag)
-> [EpheCalcOption] -> [EpheCalcFlag]
forall a b. (a -> b) -> [a] -> [b]
map EpheCalcOption -> EpheCalcFlag
epheOptionToFlag
          ([EpheCalcOption] -> [EpheCalcFlag])
-> (NonEmpty EpheCalcOption -> [EpheCalcOption])
-> NonEmpty EpheCalcOption
-> [EpheCalcFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty EpheCalcOption -> [EpheCalcOption]
forall a. NonEmpty a -> [a]
toList
          (NonEmpty EpheCalcOption -> EpheCalcFlag)
-> NonEmpty EpheCalcOption -> EpheCalcFlag
forall a b. (a -> b) -> a -> b
$ NonEmpty EpheCalcOption
calcOptions
  Either String EpheVector
ephe <- PlanetListFlag
-> EpheCalcFlag -> JulianDayTT -> IO (Either String EpheVector)
readEphemerisRaw PlanetListFlag
plalist EpheCalcFlag
flag JulianDayTT
time
  Either String a -> IO (Either String a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption -> JulianDayTT -> EpheVector -> a
mkEphemeris NonEmpty PlanetListOption
planetOptions NonEmpty EpheCalcOption
calcOptions JulianDayTT
time (EpheVector -> a) -> Either String EpheVector -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String EpheVector
ephe

-- | A version of 'readEphemeris' that wraps all longitudes, speeds,
-- ecliptic and nutation in 'Maybe's: if a given planet is configured
-- to be skipped, its longitude will be 'Nothing'; same for all speeds,
-- ecliptic and nutation if the respective options are set.
readEphemerisStrict ::
  NonEmpty PlanetListOption ->
  NonEmpty EpheCalcOption ->
  JulianDayTT  ->
  IO (Either String (Ephemeris (Maybe Double)))
readEphemerisStrict :: NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String (Ephemeris (Maybe Double)))
readEphemerisStrict = (NonEmpty PlanetListOption
 -> NonEmpty EpheCalcOption
 -> JulianDayTT
 -> EpheVector
 -> Ephemeris (Maybe Double))
-> NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String (Ephemeris (Maybe Double)))
forall a.
(NonEmpty PlanetListOption
 -> NonEmpty EpheCalcOption -> JulianDayTT -> EpheVector -> a)
-> NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String a)
readEphemeris NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> EpheVector
-> Ephemeris (Maybe Double)
mkEphemerisStrict

-- | A version of 'readEphemeris' that always includes all planets and all
-- speeds, as well as ecliptic and nutation.
readEphemerisSimple ::
  NonEmpty PlanetListOption ->
  NonEmpty EpheCalcOption ->
  JulianDayTT  ->
  IO (Either String (Ephemeris Double))
readEphemerisSimple :: NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String (Ephemeris Double))
readEphemerisSimple = (NonEmpty PlanetListOption
 -> NonEmpty EpheCalcOption
 -> JulianDayTT
 -> EpheVector
 -> Ephemeris Double)
-> NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String (Ephemeris Double))
forall a.
(NonEmpty PlanetListOption
 -> NonEmpty EpheCalcOption -> JulianDayTT -> EpheVector -> a)
-> NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String a)
readEphemeris NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> EpheVector
-> Ephemeris Double
mkEphemerisSimple

-- | A version of 'readEphemeris' that always gets all planets,
-- ecliptic and nutation, always includes speed,
-- and allows falling back to non-stored
-- @swe_calc@ for dates/planets outside of the stored range (
-- via the @allowFallback@ 'Bool' parameter.)
--
-- I recommend using this one: as mentioned elsewhere, the underlying
-- library will /always/ calculate all ephemeris and all speeds, the only
-- material difference is that if it has to fall back to the underlying ephemeris,
-- it _will_ skip calculating any specified planets or speeds. I personally
-- use the "no fallback" version.
readEphemerisEasy :: Bool -> JulianDayTT  -> IO (Either String (Ephemeris Double))
readEphemerisEasy :: Bool -> JulianDayTT -> IO (Either String (Ephemeris Double))
readEphemerisEasy Bool
allowFallback =
  NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> IO (Either String (Ephemeris Double))
readEphemerisSimple
    (PlanetListOption
IncludeAll PlanetListOption -> [PlanetListOption] -> NonEmpty PlanetListOption
forall a. a -> [a] -> NonEmpty a
:| [])
    (if Bool
allowFallback then NonEmpty EpheCalcOption
withFallback else NonEmpty EpheCalcOption
noFallback)
  where
    withFallback :: NonEmpty EpheCalcOption
withFallback = EpheCalcOption
IncludeSpeed EpheCalcOption -> [EpheCalcOption] -> NonEmpty EpheCalcOption
forall a. a -> [a] -> NonEmpty a
:| []
    noFallback :: NonEmpty EpheCalcOption
noFallback = EpheCalcOption
IncludeSpeed EpheCalcOption -> [EpheCalcOption] -> NonEmpty EpheCalcOption
forall a. a -> [a] -> NonEmpty a
:| [EpheCalcOption
MustUseStoredEphe]

-- | A 'law-abiding' ephemeris maker, producing the more complex
-- type with optional values, as determined by the underlying library's
-- flags. Implemented for thoroughness, but not as useful as it looks:
-- the underlying library will calculate everything even if we request
-- it not to, so turning off certain planets, speeds or nutation/ecliptic
-- is more of an exercise in pedantry than in optimization.
mkEphemerisStrict ::
  NonEmpty PlanetListOption ->
  NonEmpty EpheCalcOption ->
  JulianDayTT  ->
  EpheVector ->
  Ephemeris (Maybe Double)
mkEphemerisStrict :: NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> EpheVector
-> Ephemeris (Maybe Double)
mkEphemerisStrict NonEmpty PlanetListOption
planetOptions NonEmpty EpheCalcOption
calcOptions JulianDayTT
time EpheVector
results' =
  Ephemeris :: forall a.
JulianDayTT
-> a -> a -> Vector (EphemerisPosition a) -> Ephemeris a
Ephemeris
    { epheDate :: JulianDayTT
epheDate = JulianDayTT
time,
      epheEcliptic :: Maybe Double
epheEcliptic = Maybe Double
ecl Maybe Double -> [PlanetListOption] -> Maybe Double
forall a. Maybe a -> [PlanetListOption] -> Maybe a
`givenPlanetOptions` [PlanetListOption
IncludeEcliptic, PlanetListOption
IncludeAll],
      epheNutation :: Maybe Double
epheNutation = Maybe Double
nut Maybe Double -> [PlanetListOption] -> Maybe Double
forall a. Maybe a -> [PlanetListOption] -> Maybe a
`givenPlanetOptions` [PlanetListOption
IncludeNutation, PlanetListOption
IncludeAll],
      ephePositions :: Vector (EphemerisPosition (Maybe Double))
ephePositions = Vector (EphemerisPosition (Maybe Double))
ps
    }
  where
    givenPlanetOptions :: Maybe a -> [PlanetListOption] -> Maybe a
givenPlanetOptions Maybe a
val [PlanetListOption]
opts =
      if [PlanetListOption] -> Bool
hasPlanetOptions [PlanetListOption]
opts then Maybe a
val else Maybe a
forall a. Maybe a
Nothing
    hasPlanetOptions :: [PlanetListOption] -> Bool
hasPlanetOptions = Bool -> Bool
not (Bool -> Bool)
-> ([PlanetListOption] -> Bool) -> [PlanetListOption] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlanetListOption] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([PlanetListOption] -> Bool)
-> ([PlanetListOption] -> [PlanetListOption])
-> [PlanetListOption]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlanetListOption] -> [PlanetListOption] -> [PlanetListOption]
forall a. Eq a => [a] -> [a] -> [a]
intersect (NonEmpty PlanetListOption -> [PlanetListOption]
forall a. NonEmpty a -> [a]
toList NonEmpty PlanetListOption
planetOptions)
    givenCalcOptions :: a -> [EpheCalcOption] -> Maybe a
givenCalcOptions a
val [EpheCalcOption]
opts =
      if [EpheCalcOption] -> Bool
hasCalcOptions [EpheCalcOption]
opts then a -> Maybe a
forall a. a -> Maybe a
Just a
val else Maybe a
forall a. Maybe a
Nothing
    hasCalcOptions :: [EpheCalcOption] -> Bool
hasCalcOptions = Bool -> Bool
not (Bool -> Bool)
-> ([EpheCalcOption] -> Bool) -> [EpheCalcOption] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EpheCalcOption] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([EpheCalcOption] -> Bool)
-> ([EpheCalcOption] -> [EpheCalcOption])
-> [EpheCalcOption]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EpheCalcOption] -> [EpheCalcOption] -> [EpheCalcOption]
forall a. Eq a => [a] -> [a] -> [a]
intersect (NonEmpty EpheCalcOption -> [EpheCalcOption]
forall a. NonEmpty a -> [a]
toList NonEmpty EpheCalcOption
calcOptions)

    singleFactors :: Int
singleFactors = EpheConst -> Int
unConst EpheConst
numberOfFactors
    results :: Vector Double
results = EpheVector -> Vector Double
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert EpheVector
results'
    (Vector Double
factors, Vector Double
speeds) = Int -> Vector Double -> (Vector Double, Vector Double)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
singleFactors Vector Double
results
    ecl :: Maybe Double
ecl = Vector Double
factors Vector Double -> Int -> Maybe Double
forall a. Vector a -> Int -> Maybe a
V.!? EpheConst -> Int
unConst EpheConst
eclipticIndex
    nut :: Maybe Double
nut = Vector Double
factors Vector Double -> Int -> Maybe Double
forall a. Vector a -> Int -> Maybe a
V.!? EpheConst -> Int
unConst EpheConst
nutationIndex
    ps :: Vector (EphemerisPosition (Maybe Double))
ps = (Double -> Double -> Planet -> EphemerisPosition (Maybe Double))
-> Vector Double
-> Vector Double
-> Vector Planet
-> Vector (EphemerisPosition (Maybe Double))
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3 Double -> Double -> Planet -> EphemerisPosition (Maybe Double)
forall a. a -> a -> Planet -> EphemerisPosition (Maybe a)
mkEphePos Vector Double
factors Vector Double
speeds ([Planet] -> Vector Planet
forall a. [a] -> Vector a
V.fromList [Planet]
placalcOrdering)
    mkEphePos :: a -> a -> Planet -> EphemerisPosition (Maybe a)
mkEphePos a
planetPos a
planetSpeed Planet
planet' =
      EphemerisPosition :: forall a. Planet -> a -> a -> EphemerisPosition a
EphemerisPosition
        { ephePlanet :: Planet
ephePlanet = Planet
planet',
          -- TODO(luis) /technically/, we should only include the longitude
          -- if the planet was supposed to be included; but I always ask
          -- for all planets; it's really only worth it for cases where one
          -- wants to allow the fallback and thus limit /that/ calculation.
          epheLongitude :: Maybe a
epheLongitude = a -> Maybe a
forall a. a -> Maybe a
Just a
planetPos,
          epheSpeed :: Maybe a
epheSpeed = a
planetSpeed a -> [EpheCalcOption] -> Maybe a
forall a. a -> [EpheCalcOption] -> Maybe a
`givenCalcOptions` [EpheCalcOption
IncludeSpeed]
        }

mkEphemerisSimple ::
  NonEmpty PlanetListOption ->
  NonEmpty EpheCalcOption ->
  JulianDayTT  ->
  EpheVector ->
  Ephemeris Double
mkEphemerisSimple :: NonEmpty PlanetListOption
-> NonEmpty EpheCalcOption
-> JulianDayTT
-> EpheVector
-> Ephemeris Double
mkEphemerisSimple NonEmpty PlanetListOption
_ NonEmpty EpheCalcOption
_ JulianDayTT
time EpheVector
results' =
  Ephemeris :: forall a.
JulianDayTT
-> a -> a -> Vector (EphemerisPosition a) -> Ephemeris a
Ephemeris
    { epheDate :: JulianDayTT
epheDate = JulianDayTT
time,
      epheEcliptic :: Double
epheEcliptic = Double
ecl,
      epheNutation :: Double
epheNutation = Double
nut,
      ephePositions :: Vector (EphemerisPosition Double)
ephePositions = Vector (EphemerisPosition Double)
ps
    }
  where
    singleFactors :: Int
singleFactors = EpheConst -> Int
unConst EpheConst
numberOfFactors
    results :: Vector Double
results = EpheVector -> Vector Double
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert EpheVector
results'
    (Vector Double
factors, Vector Double
speeds) = Int -> Vector Double -> (Vector Double, Vector Double)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
singleFactors Vector Double
results
    -- ecl and nut are /always/ present, even when not
    -- requested; they just happen to be garbage if not requested.
    ecl :: Double
ecl = Vector Double
factors Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! EpheConst -> Int
unConst EpheConst
eclipticIndex
    nut :: Double
nut = Vector Double
factors Vector Double -> Int -> Double
forall a. Vector a -> Int -> a
V.! EpheConst -> Int
unConst EpheConst
nutationIndex
    ps :: Vector (EphemerisPosition Double)
ps = (Double -> Double -> Planet -> EphemerisPosition Double)
-> Vector Double
-> Vector Double
-> Vector Planet
-> Vector (EphemerisPosition Double)
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3 Double -> Double -> Planet -> EphemerisPosition Double
forall a. a -> a -> Planet -> EphemerisPosition a
mkEphePos Vector Double
factors Vector Double
speeds ([Planet] -> Vector Planet
forall a. [a] -> Vector a
V.fromList [Planet]
placalcOrdering)
    mkEphePos :: a -> a -> Planet -> EphemerisPosition a
mkEphePos a
planetPos a
planetSpeed Planet
planet' =
      EphemerisPosition :: forall a. Planet -> a -> a -> EphemerisPosition a
EphemerisPosition
        { ephePlanet :: Planet
ephePlanet = Planet
planet',
          -- TODO(luis) /technically/, we should only include the longitude
          -- if the planet was supposed to be included; but I always ask
          -- for all planets; it's really only worth it for cases where one
          -- wants to allow the fallback and thus limit /that/ calculation.
          epheLongitude :: a
epheLongitude = a
planetPos,
          epheSpeed :: a
epheSpeed = a
planetSpeed
        }

-- | Lower-level version of 'readEphemeris':
--
-- * Expects options as bit flags set in a 'PlanetListFlag'; idem for 'EpheCalcFlag'
--   options. This is useful if one really wants to get into the setting bit flags
--   to select planets adventure.
-- * Returns a simple unboxed vector of 'Double's, where the first 'numberOfFactors'
--   elements are the planets, ecliptic and nutation; and the rest are speeds.
--   (the underlying library /always/ returns the full array, but if planets
--    ecliptic, nutation or ommitted, they won't be populated.)
-- * The underlying implementation uses a @static@ array, which means that
--   between invocations, quantities that are not calculated again linger (e.g.
--   you asked for all planets, all speeds, ecliptic and nutation in one pass,
--   and then only ask for certain planets, no speeds, no ecl/nut:
--   /the previous values for these will be there!/) I've left it as-is here,
--   but made the behavior more predictable in 'readEphemeris'.
--
-- Due to the somewhat leaky/tricky nature of the underlying interface, this
-- function is provided merely for experimental usage -- you very likely want
-- 'readEphemeris'!
readEphemerisRaw ::
  PlanetListFlag ->
  EpheCalcFlag ->
  JulianDayTT  ->
  IO (Either String EpheVector)
readEphemerisRaw :: PlanetListFlag
-> EpheCalcFlag -> JulianDayTT -> IO (Either String EpheVector)
readEphemerisRaw PlanetListFlag
plalist EpheCalcFlag
flag JulianDayTT
timeTT =
  (CString -> IO (Either String EpheVector))
-> IO (Either String EpheVector)
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either String EpheVector))
 -> IO (Either String EpheVector))
-> (CString -> IO (Either String EpheVector))
-> IO (Either String EpheVector)
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    Ptr CDouble
ephe <-
      CDouble
-> PlanetListFlag -> EpheCalcFlag -> CString -> IO (Ptr CDouble)
c_dephread2
        (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDayTT -> Double) -> JulianDayTT -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDayTT -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDayTT -> CDouble) -> JulianDayTT -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDayTT
timeTT)
        PlanetListFlag
plalist
        EpheCalcFlag
flag
        CString
serr
    if Ptr CDouble
ephe Ptr CDouble -> Ptr CDouble -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CDouble
forall a. Ptr a
nullPtr
      then do
        String
err <- CString -> IO String
peekCAString CString
serr
        Either String EpheVector -> IO (Either String EpheVector)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String EpheVector -> IO (Either String EpheVector))
-> Either String EpheVector -> IO (Either String EpheVector)
forall a b. (a -> b) -> a -> b
$ String -> Either String EpheVector
forall a b. a -> Either a b
Left String
err
      else do
        let noFactors :: Int
noFactors = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> CInt -> Int
forall a b. (a -> b) -> a -> b
$ CInt
2 CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
* EpheConst -> CInt
unEpheConst EpheConst
numberOfFactors
        -- the underlying library _always_ allocates `EP_NP` factors
        -- times two (to also include speeds.)
        [CDouble]
factors <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
noFactors Ptr CDouble
ephe
        let vector :: EpheVector
vector = [Double] -> EpheVector
forall a. Unbox a => [a] -> Vector a
VU.fromList ([Double] -> EpheVector)
-> ([CDouble] -> [Double]) -> [CDouble] -> EpheVector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> EpheVector) -> [CDouble] -> EpheVector
forall a b. (a -> b) -> a -> b
$ [CDouble]
factors
        Either String EpheVector -> IO (Either String EpheVector)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String EpheVector -> IO (Either String EpheVector))
-> Either String EpheVector -> IO (Either String EpheVector)
forall a b. (a -> b) -> a -> b
$ EpheVector -> Either String EpheVector
forall a b. b -> Either a b
Right EpheVector
vector

-- | For the most basic case: read ephemeris without falling back
-- to the non-stored variant, and always include speeds, all planets,
-- ecliptic and nutation.
readEphemerisRawNoFallback :: JulianDayTT  -> IO (Either String EpheVector)
readEphemerisRawNoFallback :: JulianDayTT -> IO (Either String EpheVector)
readEphemerisRawNoFallback =
  PlanetListFlag
-> EpheCalcFlag -> JulianDayTT -> IO (Either String EpheVector)
readEphemerisRaw PlanetListFlag
calculateAll EpheCalcFlag
addSpeedNoFallback
  where
    -- an empty lists yields a flag with value @0@, which the underlying
    -- library considers equivalent to 'includeAll'.
    calculateAll :: PlanetListFlag
calculateAll = CInt -> PlanetListFlag
PlanetListFlag CInt
0
    addSpeedNoFallback :: EpheCalcFlag
addSpeedNoFallback =
      [EpheCalcFlag] -> EpheCalcFlag
foldEpheCalcOptions ([EpheCalcFlag] -> EpheCalcFlag) -> [EpheCalcFlag] -> EpheCalcFlag
forall a b. (a -> b) -> a -> b
$ (EpheCalcOption -> EpheCalcFlag)
-> [EpheCalcOption] -> [EpheCalcFlag]
forall a b. (a -> b) -> [a] -> [b]
map EpheCalcOption -> EpheCalcFlag
epheOptionToFlag [EpheCalcOption
IncludeSpeed, EpheCalcOption
MustUseStoredEphe]

-- | Persist a 10,000 day block of ephemeris to disk, given a julian prefix.
--
-- This is a highly side-effectful function:
--
-- * It assumes you've set usable paths to both the @sep4@ files and
--   usable ephemeris. A @Left@ value will be returned otherwise.
-- * It is /not/ friendly to repeated invocations: if you happen to run
--   it in sequence with the same block number, undefined behavior may arise
--   where the file is still "open" as far as the underlying library is concerned,
--   because it keeps its own cursor, but the file descriptior will be closed. We
--   can fix that, but it introduces a divergence in the code that I'd rather just
--   warn about for the time being.
writeEphemeris :: EphemerisBlockNumber -> IO (Either String EphemerisBlockNumber)
writeEphemeris :: EphemerisBlockNumber -> IO (Either String EphemerisBlockNumber)
writeEphemeris bn :: EphemerisBlockNumber
bn@(EphemerisBlockNumber Int
n) = do
  (CString -> IO (Either String EphemerisBlockNumber))
-> IO (Either String EphemerisBlockNumber)
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either String EphemerisBlockNumber))
 -> IO (Either String EphemerisBlockNumber))
-> (CString -> IO (Either String EphemerisBlockNumber))
-> IO (Either String EphemerisBlockNumber)
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
    CInt
retval <-
      CInt -> CString -> IO CInt
c_ephe4_write_file (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) CString
serr

    if CInt
retval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
      then do
        String
err <- CString -> IO String
peekCAString CString
serr
        Either String EphemerisBlockNumber
-> IO (Either String EphemerisBlockNumber)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String EphemerisBlockNumber
 -> IO (Either String EphemerisBlockNumber))
-> Either String EphemerisBlockNumber
-> IO (Either String EphemerisBlockNumber)
forall a b. (a -> b) -> a -> b
$ String -> Either String EphemerisBlockNumber
forall a b. a -> Either a b
Left String
err
      else Either String EphemerisBlockNumber
-> IO (Either String EphemerisBlockNumber)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String EphemerisBlockNumber
 -> IO (Either String EphemerisBlockNumber))
-> Either String EphemerisBlockNumber
-> IO (Either String EphemerisBlockNumber)
forall a b. (a -> b) -> a -> b
$ EphemerisBlockNumber -> Either String EphemerisBlockNumber
forall a b. b -> Either a b
Right EphemerisBlockNumber
bn

unConst :: EpheConst -> Int
unConst :: EpheConst -> Int
unConst = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> (EpheConst -> CInt) -> EpheConst -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpheConst -> CInt
unEpheConst

-------------------------------------------------------------------------
-- UTILS FOR EPHE CALC OPTS
-------------------------------------------------------------------------

-- | Fold any given flags into one number with the combined flags set.
foldEpheCalcOptions :: [EpheCalcFlag] -> EpheCalcFlag
foldEpheCalcOptions :: [EpheCalcFlag] -> EpheCalcFlag
foldEpheCalcOptions = CInt -> EpheCalcFlag
EpheCalcFlag (CInt -> EpheCalcFlag)
-> ([EpheCalcFlag] -> CInt) -> [EpheCalcFlag] -> EpheCalcFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EpheCalcFlag -> CInt -> CInt) -> CInt -> [EpheCalcFlag] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt)
-> (EpheCalcFlag -> CInt) -> EpheCalcFlag -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpheCalcFlag -> CInt
unEpheCalcFlag) CInt
0

epheOptionToFlag :: EpheCalcOption -> EpheCalcFlag
epheOptionToFlag :: EpheCalcOption -> EpheCalcFlag
epheOptionToFlag =
  \case
    EpheCalcOption
IncludeSpeed -> EpheCalcFlag
includeSpeed
    EpheCalcOption
MustUseStoredEphe -> EpheCalcFlag
mustUseStoredEphe

-------------------------------------------------------------------------
-- UTILS FOR PLANET OPTS
-- TODO:
-- We currently only allow the include* options, but the underlying
-- library _also_ allows setting bit flags for _each planet_ individually,
-- in fact, 'includeAllPlanets' is simply a value with all flags set!
-- I haven't thought of a clean way to expose that in the Haskell API,
-- but it should be doable!
-------------------------------------------------------------------------

-- | Fold any given planet flags into one datum with the combined flags set.
foldPlanetListOptions :: [PlanetListFlag] -> PlanetListFlag
foldPlanetListOptions :: [PlanetListFlag] -> PlanetListFlag
foldPlanetListOptions = CInt -> PlanetListFlag
PlanetListFlag (CInt -> PlanetListFlag)
-> ([PlanetListFlag] -> CInt) -> [PlanetListFlag] -> PlanetListFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlanetListFlag -> CInt -> CInt)
-> CInt -> [PlanetListFlag] -> CInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
(.|.) (CInt -> CInt -> CInt)
-> (PlanetListFlag -> CInt) -> PlanetListFlag -> CInt -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlanetListFlag -> CInt
unPlanetListFlag) CInt
0

planetListOptionToFlag :: PlanetListOption -> PlanetListFlag
planetListOptionToFlag :: PlanetListOption -> PlanetListFlag
planetListOptionToFlag =
  \case
    PlanetListOption
IncludeAllPlanets -> PlanetListFlag
includeAllPlanets
    PlanetListOption
IncludeEcliptic -> PlanetListFlag
includeEcliptic
    PlanetListOption
IncludeNutation -> PlanetListFlag
includeNutation
    PlanetListOption
IncludeAll -> PlanetListFlag
includeAll

-- | An order-equivalent version of the 'PlacalcPlanet' enum
placalcOrdering :: [Planet]
placalcOrdering :: [Planet]
placalcOrdering =
  [ Planet
Sun,
    Planet
Moon,
    Planet
Mercury,
    Planet
Venus,
    Planet
Mars,
    Planet
Jupiter,
    Planet
Saturn,
    Planet
Uranus,
    Planet
Neptune,
    Planet
Pluto,
    Planet
MeanNode,
    Planet
TrueNode,
    Planet
Chiron,
    Planet
MeanApog
  ]

planetToPlanetOption :: Planet -> Maybe PlacalcPlanet
planetToPlanetOption :: Planet -> Maybe PlacalcPlanet
planetToPlanetOption =
  \case
    Planet
Sun -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pSun
    Planet
Moon -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pMoon
    Planet
Mercury -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pMercury
    Planet
Venus -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pVenus
    Planet
Mars -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pMars
    Planet
Jupiter -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pJupiter
    Planet
Saturn -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pSaturn
    Planet
Uranus -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pUranus
    Planet
Neptune -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pNeptune
    Planet
Pluto -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pPluto
    Planet
MeanNode -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pMeanNode
    Planet
TrueNode -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pTrueNode
    Planet
Chiron -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pChiron
    Planet
MeanApog -> PlacalcPlanet -> Maybe PlacalcPlanet
forall a. a -> Maybe a
Just PlacalcPlanet
pLilith
    Planet
_ -> Maybe PlacalcPlanet
forall a. Maybe a
Nothing

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