{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiWayIf #-}
module SwissEphemeris
(
HasEclipticLongitude(..),
HouseCusp,
SplitDegreesOption (..),
Planet (..),
HouseSystem (..),
ZodiacSignName (..),
NakshatraName (..),
EventSearchDirection(..),
PlanetMotion(..),
LunarPhaseName(..),
EclipticPosition (..),
EquatorialPosition (..),
GeographicPosition (..),
HousePosition (..),
ObliquityInformation (..),
Angles (..),
CuspsCalculation (..),
LongitudeComponents (..),
SolarEclipseInformation(..),
SolarEclipseType(..),
LunarEclipseInformation(..),
LunarEclipseType(..),
setEphemeridesPath,
setNoEphemeridesPath,
closeEphemerides,
withEphemerides,
withoutEphemerides,
calculateEclipticPosition,
calculateEquatorialPosition,
calculateObliquity,
calculateCusps,
calculateCuspsLenient,
calculateCuspsStrict,
equatorialToEcliptic,
eclipticToEquatorial,
calculateHousePosition,
calculateHousePositionSimple,
defaultSplitDegreesOptions,
splitDegrees,
splitDegreesZodiac,
planetaryPhenomenon,
planetaryPhenomenonRaw,
sunCrossing,
sunCrossingBetween,
moonCrossing,
moonCrossingBetween,
moonCrossingNode,
heliocentricCrossing,
crossingBetween,
nextSolarEclipse,
nextSolarEclipseWhen,
nextSolarEclipseWhere,
nextLunarEclipse,
nextLunarEclipseWhen,
directionChangeBetween,
nextDirectionChange,
moonPhaseExactAt,
module SwissEphemeris.Time
)
where
import Control.Exception (bracket_)
import Foreign
import Foreign.C.String
import Foreign.SwissEphemeris
import Foreign.Interpolate
import SwissEphemeris.Internal
import System.IO.Unsafe (unsafePerformIO)
import SwissEphemeris.Time
import Foreign.C (CDouble, CInt)
import Data.Bifunctor (second)
import Data.Bool (bool)
setEphemeridesPath :: FilePath -> IO ()
setEphemeridesPath :: FilePath -> IO ()
setEphemeridesPath FilePath
path =
FilePath -> (CString -> IO ()) -> IO ()
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
ephePath -> CString -> IO ()
c_swe_set_ephe_path CString
ephePath
setNoEphemeridesPath :: IO ()
setNoEphemeridesPath :: IO ()
setNoEphemeridesPath = CString -> IO ()
c_swe_set_ephe_path CString
forall a. Ptr a
nullPtr
closeEphemerides :: IO ()
closeEphemerides :: IO ()
closeEphemerides = IO ()
c_swe_close
withEphemerides :: FilePath -> IO a -> IO a
withEphemerides :: FilePath -> IO a -> IO a
withEphemerides FilePath
ephemeridesPath =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
(FilePath -> IO ()
setEphemeridesPath FilePath
ephemeridesPath)
IO ()
closeEphemerides
withoutEphemerides :: IO a -> IO a
withoutEphemerides :: IO a -> IO a
withoutEphemerides =
IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
IO ()
setNoEphemeridesPath
IO ()
closeEphemerides
calculateEclipticPosition :: JulianDayUT1 -> Planet -> IO (Either String EclipticPosition)
calculateEclipticPosition :: JulianDayUT1 -> Planet -> IO (Either FilePath EclipticPosition)
calculateEclipticPosition JulianDayUT1
time Planet
planet = do
let options :: CalcFlag
options = [CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions
Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
time (Planet -> PlanetNumber
planetNumber Planet
planet)
Either FilePath EclipticPosition
-> IO (Either FilePath EclipticPosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath EclipticPosition
-> IO (Either FilePath EclipticPosition))
-> Either FilePath EclipticPosition
-> IO (Either FilePath EclipticPosition)
forall a b. (a -> b) -> a -> b
$ ([Double] -> EclipticPosition)
-> Either FilePath [Double] -> Either FilePath EclipticPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> EclipticPosition
coordinatesFromList Either FilePath [Double]
rawCoords
calculateEquatorialPosition :: JulianDayUT1 -> Planet -> IO (Either String EquatorialPosition)
calculateEquatorialPosition :: JulianDayUT1 -> Planet -> IO (Either FilePath EquatorialPosition)
calculateEquatorialPosition JulianDayUT1
time Planet
planet = do
let options :: CalcFlag
options = [CalcFlag] -> CalcFlag
mkCalculationOptions ([CalcFlag] -> CalcFlag) -> [CalcFlag] -> CalcFlag
forall a b. (a -> b) -> a -> b
$ [CalcFlag]
defaultCalculationOptions [CalcFlag] -> [CalcFlag] -> [CalcFlag]
forall a. [a] -> [a] -> [a]
++ [CalcFlag
equatorialPositions]
Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
time (Planet -> PlanetNumber
planetNumber Planet
planet)
Either FilePath EquatorialPosition
-> IO (Either FilePath EquatorialPosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath EquatorialPosition
-> IO (Either FilePath EquatorialPosition))
-> Either FilePath EquatorialPosition
-> IO (Either FilePath EquatorialPosition)
forall a b. (a -> b) -> a -> b
$ ([Double] -> EquatorialPosition)
-> Either FilePath [Double] -> Either FilePath EquatorialPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> EquatorialPosition
equatorialFromList Either FilePath [Double]
rawCoords
calculateObliquity :: JulianDayUT1 -> IO (Either String ObliquityInformation)
calculateObliquity :: JulianDayUT1 -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianDayUT1
time = do
let options :: CalcFlag
options = CInt -> CalcFlag
CalcFlag CInt
0
Either FilePath [Double]
rawCoords <- CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
time PlanetNumber
specialEclNut
Either FilePath ObliquityInformation
-> IO (Either FilePath ObliquityInformation)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath ObliquityInformation
-> IO (Either FilePath ObliquityInformation))
-> Either FilePath ObliquityInformation
-> IO (Either FilePath ObliquityInformation)
forall a b. (a -> b) -> a -> b
$ ([Double] -> ObliquityInformation)
-> Either FilePath [Double] -> Either FilePath ObliquityInformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> ObliquityInformation
obliquityNutationFromList Either FilePath [Double]
rawCoords
calculateCoordinates' :: CalcFlag -> JulianDayUT1 -> PlanetNumber -> IO (Either String [Double])
calculateCoordinates' :: CalcFlag
-> JulianDayUT1 -> PlanetNumber -> IO (Either FilePath [Double])
calculateCoordinates' CalcFlag
options JulianDayUT1
time PlanetNumber
planet =
Int
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
6 ((Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double]))
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
coords -> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double]))
-> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CalcFlag
iflgret <-
CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CalcFlag
c_swe_calc_ut
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDayUT1 -> Double) -> JulianDayUT1 -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDayUT1 -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDayUT1 -> CDouble) -> JulianDayUT1 -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDayUT1
time)
PlanetNumber
planet
CalcFlag
options
Ptr CDouble
coords
CString
serr
if CalcFlag -> CInt
unCalcFlag CalcFlag
iflgret CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then do
FilePath
msg <- CString -> IO FilePath
peekCAString CString
serr
Either FilePath [Double] -> IO (Either FilePath [Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath [Double]
forall a b. a -> Either a b
Left FilePath
msg
else do
[CDouble]
result <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
6 Ptr CDouble
coords
Either FilePath [Double] -> IO (Either FilePath [Double])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ [Double] -> Either FilePath [Double]
forall a b. b -> Either a b
Right ([Double] -> Either FilePath [Double])
-> [Double] -> Either FilePath [Double]
forall a b. (a -> b) -> a -> b
$ (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]
result
eclipticToEquatorial :: ObliquityInformation -> EclipticPosition -> EquatorialPosition
eclipticToEquatorial :: ObliquityInformation -> EclipticPosition -> EquatorialPosition
eclipticToEquatorial ObliquityInformation
oAndN EclipticPosition
ecliptic =
let obliquityLn :: Double
obliquityLn = ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
oAndN
eclipticPos :: [Double]
eclipticPos = EclipticPosition -> [Double]
eclipticToList EclipticPosition
ecliptic
transformed :: [Double]
transformed = Double -> [Double] -> [Double]
coordinateTransform' (Double -> Double
forall a. Num a => a -> a
negate Double
obliquityLn) [Double]
eclipticPos
in [Double] -> EquatorialPosition
equatorialFromList [Double]
transformed
equatorialToEcliptic :: ObliquityInformation -> EquatorialPosition -> EclipticPosition
equatorialToEcliptic :: ObliquityInformation -> EquatorialPosition -> EclipticPosition
equatorialToEcliptic ObliquityInformation
oAndN EquatorialPosition
equatorial =
let obliquityLn :: Double
obliquityLn = ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
oAndN
equatorialPos :: [Double]
equatorialPos = EquatorialPosition -> [Double]
equatorialToList EquatorialPosition
equatorial
transformed :: [Double]
transformed = Double -> [Double] -> [Double]
coordinateTransform' Double
obliquityLn [Double]
equatorialPos
in [Double] -> EclipticPosition
eclipticFromList [Double]
transformed
coordinateTransform' :: Double -> [Double] -> [Double]
coordinateTransform' :: Double -> [Double] -> [Double]
coordinateTransform' Double
obliquity [Double]
ins =
IO [Double] -> [Double]
forall a. IO a -> a
unsafePerformIO (IO [Double] -> [Double]) -> IO [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$
[CDouble] -> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Double] -> [CDouble]) -> [Double] -> [CDouble]
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
6 [Double]
ins) ((Ptr CDouble -> IO [Double]) -> IO [Double])
-> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpo -> Int -> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
6 ((Ptr CDouble -> IO [Double]) -> IO [Double])
-> (Ptr CDouble -> IO [Double]) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpn -> do
()
_ <- Ptr CDouble -> Ptr CDouble -> CDouble -> IO ()
c_swe_cotrans_sp Ptr CDouble
xpo Ptr CDouble
xpn (Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
obliquity)
[CDouble]
result <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
6 Ptr CDouble
xpn
[Double] -> IO [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Double] -> IO [Double]) -> [Double] -> IO [Double]
forall a b. (a -> b) -> a -> b
$ (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]
result
calculateCusps :: HouseSystem -> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCusps :: HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCusps = HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient
calculateCuspsLenient :: HouseSystem -> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient :: HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianDayUT1
time GeographicPosition
loc =
Int -> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
13 ((Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation)
-> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
cusps -> Int -> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation)
-> (Ptr CDouble -> IO CuspsCalculation) -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ascmc -> do
CInt
rval <-
CDouble
-> CDouble
-> CDouble
-> CInt
-> Ptr CDouble
-> Ptr CDouble
-> IO CInt
c_swe_houses
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDayUT1 -> Double) -> JulianDayUT1 -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDayUT1 -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDayUT1 -> CDouble) -> JulianDayUT1 -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDayUT1
time)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLat GeographicPosition
loc)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLng GeographicPosition
loc)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ HouseSystem -> Int
toHouseSystemFlag HouseSystem
sys)
Ptr CDouble
cusps
Ptr CDouble
ascmc
(CDouble
_ : [CDouble]
cuspsL) <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
13 Ptr CDouble
cusps
[CDouble]
anglesL <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ascmc
CuspsCalculation -> IO CuspsCalculation
forall (m :: * -> *) a. Monad m => a -> m a
return (CuspsCalculation -> IO CuspsCalculation)
-> CuspsCalculation -> IO CuspsCalculation
forall a b. (a -> b) -> a -> b
$
[Double] -> Angles -> HouseSystem -> CuspsCalculation
CuspsCalculation
((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]
cuspsL)
([Double] -> Angles
anglesFromList ([Double] -> Angles) -> [Double] -> Angles
forall a b. (a -> b) -> a -> b
$ (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]
anglesL)
(if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then HouseSystem
Porphyrius else HouseSystem
sys)
calculateCuspsStrict :: HouseSystem -> JulianDayUT1 -> GeographicPosition -> IO (Either String CuspsCalculation)
calculateCuspsStrict :: HouseSystem
-> JulianDayUT1
-> GeographicPosition
-> IO (Either FilePath CuspsCalculation)
calculateCuspsStrict HouseSystem
sys JulianDayUT1
time GeographicPosition
loc = do
calcs :: CuspsCalculation
calcs@(CuspsCalculation [Double]
_ Angles
_ HouseSystem
sys') <- HouseSystem
-> JulianDayUT1 -> GeographicPosition -> IO CuspsCalculation
calculateCuspsLenient HouseSystem
sys JulianDayUT1
time GeographicPosition
loc
if HouseSystem
sys' HouseSystem -> HouseSystem -> Bool
forall a. Eq a => a -> a -> Bool
/= HouseSystem
sys
then Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation))
-> Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath CuspsCalculation
forall a b. a -> Either a b
Left (FilePath -> Either FilePath CuspsCalculation)
-> FilePath -> Either FilePath CuspsCalculation
forall a b. (a -> b) -> a -> b
$ FilePath
"Unable to calculate cusps in the requested house system (used " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ HouseSystem -> FilePath
forall a. Show a => a -> FilePath
show HouseSystem
sys' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" instead.)"
else Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation))
-> Either FilePath CuspsCalculation
-> IO (Either FilePath CuspsCalculation)
forall a b. (a -> b) -> a -> b
$ CuspsCalculation -> Either FilePath CuspsCalculation
forall a b. b -> Either a b
Right CuspsCalculation
calcs
calculateHousePositionSimple :: HouseSystem -> JulianDayUT1 -> GeographicPosition -> EclipticPosition -> IO (Either String HousePosition)
calculateHousePositionSimple :: HouseSystem
-> JulianDayUT1
-> GeographicPosition
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePositionSimple HouseSystem
sys JulianDayUT1
time GeographicPosition
loc EclipticPosition
pos = do
Either FilePath ObliquityInformation
obliquityAndNutation <- JulianDayUT1 -> IO (Either FilePath ObliquityInformation)
calculateObliquity JulianDayUT1
time
case Either FilePath ObliquityInformation
obliquityAndNutation of
Left FilePath
e -> Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
-> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath HousePosition
forall a b. a -> Either a b
Left FilePath
e
Right ObliquityInformation
on -> do
SiderealTime
siderealTime <- JulianDayUT1 -> ObliquityInformation -> IO SiderealTime
julianToSidereal JulianDayUT1
time ObliquityInformation
on
let armc' :: Double
armc' = SiderealTime -> Double
getSiderealTime SiderealTime
siderealTime Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
15 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ GeographicPosition -> Double
geoLng GeographicPosition
loc
HouseSystem
-> Double
-> GeographicPosition
-> ObliquityInformation
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePosition HouseSystem
sys Double
armc' GeographicPosition
loc ObliquityInformation
on EclipticPosition
pos
calculateHousePosition :: HouseSystem -> Double -> GeographicPosition -> ObliquityInformation -> EclipticPosition -> IO (Either String HousePosition)
calculateHousePosition :: HouseSystem
-> Double
-> GeographicPosition
-> ObliquityInformation
-> EclipticPosition
-> IO (Either FilePath HousePosition)
calculateHousePosition HouseSystem
sys Double
armc' GeographicPosition
geoCoords ObliquityInformation
obliq EclipticPosition
eclipticCoords =
[CDouble]
-> (Ptr CDouble -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ EclipticPosition -> Double
lng EclipticPosition
eclipticCoords, Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ EclipticPosition -> Double
lat EclipticPosition
eclipticCoords] ((Ptr CDouble -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition))
-> (Ptr CDouble -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xpin -> (CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition))
-> (CString -> IO (Either FilePath HousePosition))
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CDouble
housePos <-
CDouble
-> CDouble
-> CDouble
-> CInt
-> Ptr CDouble
-> CString
-> IO CDouble
c_swe_house_pos
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
armc')
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ GeographicPosition -> Double
geoLat GeographicPosition
geoCoords)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> Double -> CDouble
forall a b. (a -> b) -> a -> b
$ ObliquityInformation -> Double
eclipticObliquity ObliquityInformation
obliq)
(Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ HouseSystem -> Int
toHouseSystemFlag HouseSystem
sys)
Ptr CDouble
xpin
CString
serr
if CDouble
housePos CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
<= CDouble
0
then do
FilePath
msg <- CString -> IO FilePath
peekCAString CString
serr
Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
-> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath HousePosition
forall a b. a -> Either a b
Left FilePath
msg
else do
let houseN :: Int
houseN = CDouble -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate CDouble
housePos
cuspD :: CDouble
cuspD = CDouble
housePos CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
- Int -> CDouble
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
houseN
Either FilePath HousePosition -> IO (Either FilePath HousePosition)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath HousePosition
-> IO (Either FilePath HousePosition))
-> Either FilePath HousePosition
-> IO (Either FilePath HousePosition)
forall a b. (a -> b) -> a -> b
$ HousePosition -> Either FilePath HousePosition
forall a b. b -> Either a b
Right (HousePosition -> Either FilePath HousePosition)
-> HousePosition -> Either FilePath HousePosition
forall a b. (a -> b) -> a -> b
$ Int -> Double -> HousePosition
HousePosition Int
houseN (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
cuspD)
splitDegreesZodiac :: Double -> LongitudeComponents
splitDegreesZodiac :: Double -> LongitudeComponents
splitDegreesZodiac = [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees ([SplitDegreesOption] -> Double -> LongitudeComponents)
-> [SplitDegreesOption] -> Double -> LongitudeComponents
forall a b. (a -> b) -> a -> b
$ [SplitDegreesOption]
defaultSplitDegreesOptions [SplitDegreesOption]
-> [SplitDegreesOption] -> [SplitDegreesOption]
forall a. [a] -> [a] -> [a]
++ [SplitDegreesOption
SplitZodiacal, SplitDegreesOption
RoundSeconds]
splitDegrees :: [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees :: [SplitDegreesOption] -> Double -> LongitudeComponents
splitDegrees [SplitDegreesOption]
options Double
d =
Maybe ZodiacSignName
-> Integer
-> Integer
-> Integer
-> Double
-> Maybe Int
-> Maybe NakshatraName
-> LongitudeComponents
LongitudeComponents Maybe ZodiacSignName
sign Integer
deg Integer
m Integer
s Double
sf Maybe Int
signum' Maybe NakshatraName
nak
where
(Int
z, Integer
deg, Integer
m, Integer
s, Double
sf) = SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' SplitDegFlag
flags Double
d
flags :: SplitDegFlag
flags = [SplitDegFlag] -> SplitDegFlag
foldSplitDegOptions ([SplitDegFlag] -> SplitDegFlag) -> [SplitDegFlag] -> SplitDegFlag
forall a b. (a -> b) -> a -> b
$ (SplitDegreesOption -> SplitDegFlag)
-> [SplitDegreesOption] -> [SplitDegFlag]
forall a b. (a -> b) -> [a] -> [b]
map SplitDegreesOption -> SplitDegFlag
splitOptionToFlag [SplitDegreesOption]
options
isZodiacSplit :: Bool
isZodiacSplit = SplitDegreesOption
SplitZodiacal SplitDegreesOption -> [SplitDegreesOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SplitDegreesOption]
options
isNakshatraSplit :: Bool
isNakshatraSplit = SplitDegreesOption
SplitNakshatra SplitDegreesOption -> [SplitDegreesOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SplitDegreesOption]
options
sign :: Maybe ZodiacSignName
sign = if Bool
isZodiacSplit then ZodiacSignName -> Maybe ZodiacSignName
forall a. a -> Maybe a
Just (ZodiacSignName -> Maybe ZodiacSignName)
-> (Int -> ZodiacSignName) -> Int -> Maybe ZodiacSignName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ZodiacSignName
forall a. Enum a => Int -> a
toEnum (Int -> Maybe ZodiacSignName) -> Int -> Maybe ZodiacSignName
forall a b. (a -> b) -> a -> b
$ Int
z else Maybe ZodiacSignName
forall a. Maybe a
Nothing
nak :: Maybe NakshatraName
nak = if Bool
isNakshatraSplit then NakshatraName -> Maybe NakshatraName
forall a. a -> Maybe a
Just (NakshatraName -> Maybe NakshatraName)
-> (Int -> NakshatraName) -> Int -> Maybe NakshatraName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> NakshatraName
forall a. Enum a => Int -> a
toEnum (Int -> Maybe NakshatraName) -> Int -> Maybe NakshatraName
forall a b. (a -> b) -> a -> b
$ Int
z else Maybe NakshatraName
forall a. Maybe a
Nothing
signum' :: Maybe Int
signum' = if Bool -> Bool
not Bool
isZodiacSplit Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isNakshatraSplit then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
z else Maybe Int
forall a. Maybe a
Nothing
splitDegrees' :: SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' :: SplitDegFlag -> Double -> (Int, Integer, Integer, Integer, Double)
splitDegrees' SplitDegFlag
options Double
deg =
IO (Int, Integer, Integer, Integer, Double)
-> (Int, Integer, Integer, Integer, Double)
forall a. IO a -> a
unsafePerformIO (IO (Int, Integer, Integer, Integer, Double)
-> (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
-> (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$
(Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
ideg -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
imin -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
isec -> (Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CDouble -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
dsecfr -> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double))
-> (Ptr CInt -> IO (Int, Integer, Integer, Integer, Double))
-> IO (Int, Integer, Integer, Integer, Double)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
isign -> do
Ptr CDouble -> CDouble -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CDouble
dsecfr CDouble
0
()
_ <-
CDouble
-> SplitDegFlag
-> Ptr CInt
-> Ptr CInt
-> Ptr CInt
-> Ptr CDouble
-> Ptr CInt
-> IO ()
c_swe_split_deg
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
deg)
SplitDegFlag
options
Ptr CInt
ideg
Ptr CInt
imin
Ptr CInt
isec
Ptr CDouble
dsecfr
Ptr CInt
isign
CInt
sign' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isign
CInt
deg' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
ideg
CInt
min' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
imin
CInt
sec' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isec
CDouble
secfr <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
dsecfr
(Int, Integer, Integer, Integer, Double)
-> IO (Int, Integer, Integer, Integer, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sign', CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
deg', CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
min', CInt -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sec', CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
secfr)
planetaryPhenomenonRaw :: SingTSI ts =>
JulianDay ts ->
PlanetNumber ->
CalcFlag ->
IO (Either String [Double])
planetaryPhenomenonRaw :: JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
planetaryPhenomenonRaw = SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
forall (ts :: TimeStandard).
SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
planetaryPhenomenonRaw' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
planetaryPhenomenonRaw' ::
SingTimeStandard ts ->
JulianDay ts ->
PlanetNumber ->
CalcFlag ->
IO (Either String [Double])
planetaryPhenomenonRaw' :: SingTimeStandard ts
-> JulianDay ts
-> PlanetNumber
-> CalcFlag
-> IO (Either FilePath [Double])
planetaryPhenomenonRaw' SingTimeStandard ts
sing JulianDay ts
jd PlanetNumber
ipl CalcFlag
iflag =
let fn :: CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn :: CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
c_swe_pheno
SingTimeStandard ts
_ -> CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
c_swe_pheno_ut
in (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double]))
-> (CString -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
Int
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
20 ((Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double]))
-> (Ptr CDouble -> IO (Either FilePath [Double]))
-> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
attr -> do
CInt
rval <-
CDouble
-> PlanetNumber -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDay ts -> Double) -> JulianDay ts -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay (JulianDay ts -> CDouble) -> JulianDay ts -> CDouble
forall a b. (a -> b) -> a -> b
$ JulianDay ts
jd)
PlanetNumber
ipl
CalcFlag
iflag
Ptr CDouble
attr
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
then do
FilePath
err <- CString -> IO FilePath
peekCAString CString
serr
Either FilePath [Double] -> IO (Either FilePath [Double])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath [Double]
forall a b. a -> Either a b
Left FilePath
err
else do
[CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
20 Ptr CDouble
attr
Either FilePath [Double] -> IO (Either FilePath [Double])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath [Double] -> IO (Either FilePath [Double]))
-> Either FilePath [Double] -> IO (Either FilePath [Double])
forall a b. (a -> b) -> a -> b
$ [Double] -> Either FilePath [Double]
forall a b. b -> Either a b
Right ([Double] -> Either FilePath [Double])
-> [Double] -> Either FilePath [Double]
forall a b. (a -> b) -> a -> b
$ (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]
attrs
planetaryPhenomenon :: SingTSI ts => Planet -> JulianDay ts -> IO (Either String PlanetPhenomenon)
planetaryPhenomenon :: Planet -> JulianDay ts -> IO (Either FilePath PlanetPhenomenon)
planetaryPhenomenon Planet
planet JulianDay ts
jd = do
let options :: CalcFlag
options = [CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions
Either FilePath [Double]
pheno <- JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
forall (ts :: TimeStandard).
SingTSI ts =>
JulianDay ts
-> PlanetNumber -> CalcFlag -> IO (Either FilePath [Double])
planetaryPhenomenonRaw JulianDay ts
jd (Planet -> PlanetNumber
planetNumber Planet
planet) CalcFlag
options
case Either FilePath [Double]
pheno of
Left FilePath
err -> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath PlanetPhenomenon
forall a b. a -> Either a b
Left FilePath
err
Right (Double
a:Double
p:Double
e:Double
d:Double
m:[Double]
_) ->
Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ PlanetPhenomenon -> Either FilePath PlanetPhenomenon
forall a b. b -> Either a b
Right (PlanetPhenomenon -> Either FilePath PlanetPhenomenon)
-> PlanetPhenomenon -> Either FilePath PlanetPhenomenon
forall a b. (a -> b) -> a -> b
$
PlanetPhenomenon :: Double -> Double -> Double -> Double -> Double -> PlanetPhenomenon
PlanetPhenomenon {
planetPhaseAngle :: Double
planetPhaseAngle = Double
a,
planetPhase :: Double
planetPhase = Double
p,
planetElongation :: Double
planetElongation = Double
e,
planetApparentDiameter :: Double
planetApparentDiameter = Double
d,
planetApparentMagnitude :: Double
planetApparentMagnitude = Double
m
}
Right [Double]
_ -> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon))
-> Either FilePath PlanetPhenomenon
-> IO (Either FilePath PlanetPhenomenon)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath PlanetPhenomenon
forall a b. a -> Either a b
Left FilePath
"Unable to calculate all attributes."
jd2C :: JulianDay s -> CDouble
jd2C :: JulianDay s -> CDouble
jd2C = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (JulianDay s -> Double) -> JulianDay s -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay s -> Double
forall (s :: TimeStandard). JulianDay s -> Double
getJulianDay
dir2C :: EventSearchDirection -> CInt
dir2C :: EventSearchDirection -> CInt
dir2C EventSearchDirection
SearchBackward = -CInt
1
dir2C EventSearchDirection
SearchForward = CInt
1
sunCrossingOpt
:: SingTSI ts
=> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossingOpt :: CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossingOpt =
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
sunCrossingOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jd =
let fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross
SingTimeStandard ts
_ -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_ut
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CDouble
nextCrossing <-
CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
CDouble
doubleJD
CalcFlag
iflag
CString
serr
if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
| CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
| Bool
otherwise ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)
sunCrossing :: SingTSI ts
=> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossing :: Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossing = CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
sunCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
sunCrossingBetweenOpt
:: SingTSI ts
=> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossingBetweenOpt :: CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt =
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
sunCrossingBetweenOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jdStart JulianDay ts
jdEnd =
let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_between
SingTimeStandard ts
_ -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_solcross_ut_between
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart
defaultErr :: FilePath
defaultErr = FilePath
"No crossing found in the specified interval."
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CDouble
nextCrossing <-
CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
CDouble
doubleJD
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
CalcFlag
iflag
CString
serr
if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr -> do
FilePath
libErr <- CString -> IO FilePath
peekCAString CString
serr
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool FilePath
libErr FilePath
defaultErr (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
libErr)
| CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
defaultErr
| Bool
otherwise ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)
sunCrossingBetween :: SingTSI ts
=> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
sunCrossingBetween :: Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetween = CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
sunCrossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
moonCrossingOpt
:: SingTSI ts
=> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossingOpt :: CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossingOpt =
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
moonCrossingOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jd =
let fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn :: CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross
SingTimeStandard ts
_ -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_ut
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CDouble
nextCrossing <-
CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
CDouble
doubleJD
CalcFlag
iflag
CString
serr
if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
| CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
| Bool
otherwise ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)
moonCrossing :: SingTSI ts
=> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossing :: Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossing = CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double -> JulianDay ts -> IO (Either FilePath (JulianDay ts))
moonCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
moonCrossingBetweenOpt
:: SingTSI ts
=> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossingBetweenOpt :: CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt =
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
moonCrossingBetweenOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Double
ln JulianDay ts
jdStart JulianDay ts
jdEnd =
let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_between
SingTimeStandard ts
_ -> CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
c_swe_mooncross_ut_between
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart
defaultErr :: FilePath
defaultErr = FilePath
"No crossing found in the specified interval."
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr -> do
CDouble
nextCrossing <-
CDouble -> CDouble -> CDouble -> CalcFlag -> CString -> IO CDouble
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
CDouble
doubleJD
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
CalcFlag
iflag
CString
serr
if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr -> do
FilePath
libErr <- CString -> IO FilePath
peekCAString CString
serr
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool -> FilePath
forall a. a -> a -> Bool -> a
bool FilePath
libErr FilePath
defaultErr (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
libErr)
| CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (FilePath -> Either FilePath (JulianDay ts))
-> FilePath
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts)))
-> FilePath -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ FilePath
defaultErr
| Bool
otherwise ->
Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts)
-> IO (Either FilePath (JulianDay ts)))
-> (JulianDay ts -> Either FilePath (JulianDay ts))
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> IO (Either FilePath (JulianDay ts)))
-> JulianDay ts -> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing)
moonCrossingBetween :: SingTSI ts
=> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonCrossingBetween :: Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetween = CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonCrossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
moonCrossingNodeOpt'
:: SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNodeOpt' :: SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt' SingTimeStandard ts
sing CalcFlag
iflag JulianDay ts
jd =
let fn :: CDouble -> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
fn :: CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
c_swe_mooncross_node
SingTimeStandard ts
_ -> CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
c_swe_mooncross_node_ut
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
in
(CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (CString -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xlon -> (Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (Ptr CDouble
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
xlat -> do
CDouble
nextCrossing <-
CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CDouble
fn
CDouble
doubleJD
CalcFlag
iflag
Ptr CDouble
xlon
Ptr CDouble
xlat
CString
serr
if | CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD Bool -> Bool -> Bool
&& CString
serr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr ->
FilePath -> Either FilePath (JulianDay ts, Double, Double)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, Double, Double))
-> IO FilePath
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
| CDouble
nextCrossing CDouble -> CDouble -> Bool
forall a. Ord a => a -> a -> Bool
< CDouble
doubleJD ->
Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (FilePath -> Either FilePath (JulianDay ts, Double, Double))
-> FilePath
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (JulianDay ts, Double, Double)
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (JulianDay ts, Double, Double)))
-> FilePath -> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$ FilePath
"No crossing found in the future."
| Bool
otherwise -> do
CDouble
moonLng <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xlon
CDouble
moonLat <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
xlat
Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> ((JulianDay ts, Double, Double)
-> Either FilePath (JulianDay ts, Double, Double))
-> (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, Double, Double)
-> Either FilePath (JulianDay ts, Double, Double)
forall a b. b -> Either a b
Right ((JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double)))
-> (JulianDay ts, Double, Double)
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall a b. (a -> b) -> a -> b
$
(SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
nextCrossing),
CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
moonLng,
CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
moonLat)
moonCrossingNodeOpt :: SingTSI ts => CalcFlag -> JulianDay ts -> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNodeOpt :: CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt = SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
moonCrossingNode :: SingTSI ts
=> JulianDay ts
-> IO (Either String (JulianDay ts, Double, Double))
moonCrossingNode :: JulianDay ts -> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNode =
CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, Double, Double))
moonCrossingNodeOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
heliocentricCrossingOpt'
:: SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
heliocentricCrossingOpt' :: SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt' SingTimeStandard ts
sing CalcFlag
iflag EventSearchDirection
dir Planet
planet Double
ln JulianDay ts
jd =
let fn :: PlanetNumber -> CDouble -> CDouble -> CalcFlag -> CInt -> Ptr CDouble -> CString -> IO CInt
fn :: PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_helio_cross
SingTimeStandard ts
_ -> PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_helio_cross_ut
doubleJD :: CDouble
doubleJD = JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jd
in
(CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> do
CInt
rval <-
PlanetNumber
-> CDouble
-> CDouble
-> CalcFlag
-> CInt
-> Ptr CDouble
-> CString
-> IO CInt
fn
(Planet -> PlanetNumber
planetNumber Planet
planet)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
ln)
CDouble
doubleJD
CalcFlag
iflag
(EventSearchDirection -> CInt
dir2C EventSearchDirection
dir)
Ptr CDouble
nextCrossingPtr
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else do
JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
heliocentricCrossingOpt ::
SingTSI ts =>
CalcFlag -> EventSearchDirection -> Planet -> Double -> JulianDay ts -> IO (Either String (JulianDay ts))
heliocentricCrossingOpt :: CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt =
SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
heliocentricCrossing
:: SingTSI ts
=> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either String (JulianDay ts))
heliocentricCrossing :: EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossing =
CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> EventSearchDirection
-> Planet
-> Double
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
heliocentricCrossingOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
data SolarEclipseInformation = SolarEclipseInformation
{ SolarEclipseInformation -> SolarEclipseType
solarEclipseType :: SolarEclipseType
, SolarEclipseInformation -> JulianDayUT1
solarEclipseMax :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseNoon :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseBegin :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseEnd :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseTotalityBegin :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseTotalityEnd :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseCenterLineBegin :: JulianDayUT1
, SolarEclipseInformation -> JulianDayUT1
solarEclipseCenterLineEnd :: JulianDayUT1
} deriving (SolarEclipseInformation -> SolarEclipseInformation -> Bool
(SolarEclipseInformation -> SolarEclipseInformation -> Bool)
-> (SolarEclipseInformation -> SolarEclipseInformation -> Bool)
-> Eq SolarEclipseInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
$c/= :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
== :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
$c== :: SolarEclipseInformation -> SolarEclipseInformation -> Bool
Eq, Int -> SolarEclipseInformation -> FilePath -> FilePath
[SolarEclipseInformation] -> FilePath -> FilePath
SolarEclipseInformation -> FilePath
(Int -> SolarEclipseInformation -> FilePath -> FilePath)
-> (SolarEclipseInformation -> FilePath)
-> ([SolarEclipseInformation] -> FilePath -> FilePath)
-> Show SolarEclipseInformation
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SolarEclipseInformation] -> FilePath -> FilePath
$cshowList :: [SolarEclipseInformation] -> FilePath -> FilePath
show :: SolarEclipseInformation -> FilePath
$cshow :: SolarEclipseInformation -> FilePath
showsPrec :: Int -> SolarEclipseInformation -> FilePath -> FilePath
$cshowsPrec :: Int -> SolarEclipseInformation -> FilePath -> FilePath
Show)
nextSolarEclipseRaw
:: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either String (SolarEclipseType, [Double]))
nextSolarEclipseRaw :: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double]))
nextSolarEclipseRaw CalcFlag
iflag EclipseFlag
ifltype Bool
backward JulianDayUT1
jd =
(CString -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> (CString -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
Int
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ret -> do
CInt
eclType <-
CDouble
-> CalcFlag
-> EclipseFlag
-> Ptr CDouble
-> CInt
-> CString
-> IO CInt
c_swe_sol_eclipse_when_glob
(JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
CalcFlag
iflag
EclipseFlag
ifltype
Ptr CDouble
ret
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
backward)
CString
serr
if CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (SolarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (SolarEclipseType, [Double]))
-> IO FilePath -> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else do
[CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ret
case EclipseFlag -> Maybe SolarEclipseType
eclipseFlagToTypeSolar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
Maybe SolarEclipseType
Nothing ->
Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> (FilePath -> Either FilePath (SolarEclipseType, [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (SolarEclipseType, [Double])))
-> FilePath -> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Solar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
Just SolarEclipseType
set ->
Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> ((SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [Double]))
-> (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [Double])
forall a b. b -> Either a b
Right ((SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double])))
-> (SolarEclipseType, [Double])
-> IO (Either FilePath (SolarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ (SolarEclipseType
set, (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]
attrs)
nextSolarEclipseLocationRaw
:: CalcFlag
-> JulianDayUT1
-> IO (Either String (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw :: CalcFlag
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw CalcFlag
iflag JulianDayUT1
jd =
(CString
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (CString
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
Int
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 ((Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
geopos -> Int
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
20 ((Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (Ptr CDouble
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
attr -> do
CInt
eclType <-
CDouble
-> CalcFlag -> Ptr CDouble -> Ptr CDouble -> CString -> IO CInt
c_swe_sol_eclipse_where
(JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
CalcFlag
iflag
Ptr CDouble
geopos
Ptr CDouble
attr
CString
serr
if | CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 -> FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
-> Either FilePath (SolarEclipseType, [Double], [Double]))
-> IO FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
| CInt
eclType CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 -> Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (FilePath
-> Either FilePath (SolarEclipseType, [Double], [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"No eclipse occurs at the provided date"
| Bool
otherwise -> do
[CDouble]
geo <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
2 Ptr CDouble
geopos
[CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
20 Ptr CDouble
attr
case EclipseFlag -> Maybe SolarEclipseType
eclipseFlagToTypeSolar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
Maybe SolarEclipseType
Nothing ->
Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (FilePath
-> Either FilePath (SolarEclipseType, [Double], [Double]))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. a -> Either a b
Left (FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> FilePath
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Solar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
Just SolarEclipseType
set ->
Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> ((SolarEclipseType, [Double], [Double])
-> Either FilePath (SolarEclipseType, [Double], [Double]))
-> (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType, [Double], [Double])
-> Either FilePath (SolarEclipseType, [Double], [Double])
forall a b. b -> Either a b
Right ((SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double])))
-> (SolarEclipseType, [Double], [Double])
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
forall a b. (a -> b) -> a -> b
$ (SolarEclipseType
set, (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]
geo, (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]
attrs)
nextSolarEclipseLocation
:: (Either String (SolarEclipseType, [Double], [Double]) -> Either String a)
-> JulianDayUT1
-> IO (Either String a)
nextSolarEclipseLocation :: (Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a)
-> JulianDayUT1 -> IO (Either FilePath a)
nextSolarEclipseLocation Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a
mkLoc JulianDayUT1
eclDate =
Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a
mkLoc (Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a)
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double], [Double]))
nextSolarEclipseLocationRaw CalcFlag
opts JulianDayUT1
eclDate
where
opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag
nextSolarEclipseWhere
:: JulianDayUT1
-> IO (Either String GeographicPosition)
nextSolarEclipseWhere :: JulianDayUT1 -> IO (Either FilePath GeographicPosition)
nextSolarEclipseWhere =
(Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath GeographicPosition)
-> JulianDayUT1 -> IO (Either FilePath GeographicPosition)
forall a.
(Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath a)
-> JulianDayUT1 -> IO (Either FilePath a)
nextSolarEclipseLocation Either FilePath (SolarEclipseType, [Double], [Double])
-> Either FilePath GeographicPosition
forall a c.
Either FilePath (a, [Double], c)
-> Either FilePath GeographicPosition
mkGeo
where
mkGeo :: Either FilePath (a, [Double], c)
-> Either FilePath GeographicPosition
mkGeo (Left FilePath
e) = FilePath -> Either FilePath GeographicPosition
forall a b. a -> Either a b
Left FilePath
e
mkGeo (Right (a
_eclType, Double
ln:Double
lt:[Double]
_, c
_attrs)) =
GeographicPosition -> Either FilePath GeographicPosition
forall a b. b -> Either a b
Right (GeographicPosition :: Double -> Double -> GeographicPosition
GeographicPosition {geoLng :: Double
geoLng = Double
ln, geoLat :: Double
geoLat = Double
lt})
mkGeo Either FilePath (a, [Double], c)
_ =
FilePath -> Either FilePath GeographicPosition
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse location data"
nextSolarEclipseBuilder
:: (Either String (SolarEclipseType, [Double]) -> Either String a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String a)
nextSolarEclipseBuilder :: (Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a
mkEcl [SolarEclipseType]
typeFilter EventSearchDirection
dir JulianDayUT1
startDate =
Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a
mkEcl (Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> IO (Either FilePath (SolarEclipseType, [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, [Double]))
nextSolarEclipseRaw CalcFlag
opts EclipseFlag
eclOpts Bool
backward JulianDayUT1
startDate
where
opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag
eclOpts :: EclipseFlag
eclOpts =
if [SolarEclipseType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SolarEclipseType]
typeFilter then
EclipseFlag
anyEclipse
else
[EclipseFlag] -> EclipseFlag
foldEclipseOptions ([EclipseFlag] -> EclipseFlag)
-> ([SolarEclipseType] -> [EclipseFlag])
-> [SolarEclipseType]
-> EclipseFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SolarEclipseType -> EclipseFlag)
-> [SolarEclipseType] -> [EclipseFlag]
forall a b. (a -> b) -> [a] -> [b]
map SolarEclipseType -> EclipseFlag
solarEclipseTypeToFlag ([SolarEclipseType] -> EclipseFlag)
-> [SolarEclipseType] -> EclipseFlag
forall a b. (a -> b) -> a -> b
$ [SolarEclipseType]
typeFilter
backward :: Bool
backward =
case EventSearchDirection
dir of
EventSearchDirection
SearchBackward -> Bool
True
EventSearchDirection
SearchForward -> Bool
False
nextSolarEclipse :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String SolarEclipseInformation)
nextSolarEclipse :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath SolarEclipseInformation)
nextSolarEclipse =
(Either FilePath (SolarEclipseType, [Double])
-> Either FilePath SolarEclipseInformation)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath SolarEclipseInformation)
forall a.
(Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder
(Either FilePath (SolarEclipseType, [JulianDayUT1])
-> Either FilePath SolarEclipseInformation
mkSolarEcl (Either FilePath (SolarEclipseType, [JulianDayUT1])
-> Either FilePath SolarEclipseInformation)
-> (Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [JulianDayUT1]))
-> Either FilePath (SolarEclipseType, [Double])
-> Either FilePath SolarEclipseInformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SolarEclipseType, [Double])
-> (SolarEclipseType, [JulianDayUT1]))
-> Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, [JulianDayUT1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> [JulianDayUT1])
-> (SolarEclipseType, [Double])
-> (SolarEclipseType, [JulianDayUT1])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1])
-> (Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> a -> b
$ SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1)))
where
mkSolarEcl :: Either FilePath (SolarEclipseType, [JulianDayUT1])
-> Either FilePath SolarEclipseInformation
mkSolarEcl (Left FilePath
e) = FilePath -> Either FilePath SolarEclipseInformation
forall a b. a -> Either a b
Left FilePath
e
mkSolarEcl (Right (SolarEclipseType
typ, JulianDayUT1
a:JulianDayUT1
b:JulianDayUT1
c:JulianDayUT1
d:JulianDayUT1
e:JulianDayUT1
f:JulianDayUT1
g:JulianDayUT1
h:[JulianDayUT1]
_)) =
SolarEclipseInformation -> Either FilePath SolarEclipseInformation
forall a b. b -> Either a b
Right (SolarEclipseInformation
-> Either FilePath SolarEclipseInformation)
-> SolarEclipseInformation
-> Either FilePath SolarEclipseInformation
forall a b. (a -> b) -> a -> b
$
SolarEclipseType
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> SolarEclipseInformation
SolarEclipseInformation
SolarEclipseType
typ
JulianDayUT1
a
JulianDayUT1
b
JulianDayUT1
c
JulianDayUT1
d
JulianDayUT1
e
JulianDayUT1
f
JulianDayUT1
g
JulianDayUT1
h
mkSolarEcl Either FilePath (SolarEclipseType, [JulianDayUT1])
_ = FilePath -> Either FilePath SolarEclipseInformation
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
nextSolarEclipseWhen :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String (SolarEclipseType, JulianDayUT1))
nextSolarEclipseWhen :: [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, JulianDayUT1))
nextSolarEclipseWhen =
(Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, JulianDayUT1))
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (SolarEclipseType, JulianDayUT1))
forall a.
(Either FilePath (SolarEclipseType, [Double]) -> Either FilePath a)
-> [SolarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextSolarEclipseBuilder Either FilePath (SolarEclipseType, [Double])
-> Either FilePath (SolarEclipseType, JulianDayUT1)
forall a.
Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax
where
onlyMax :: Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax (Left FilePath
e) = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
e
onlyMax (Right (a
eclT, Double
jd:[Double]
_)) = (a, JulianDayUT1) -> Either FilePath (a, JulianDayUT1)
forall a b. b -> Either a b
Right (a
eclT, SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1 Double
jd)
onlyMax Either FilePath (a, [Double])
_ = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
data LunarEclipseInformation = LunarEclipseInformation
{ LunarEclipseInformation -> LunarEclipseType
lunarEclipseType :: LunarEclipseType
, LunarEclipseInformation -> JulianDayUT1
lunarEclipseMax :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipsePartialPhaseBegin :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipsePartialPhaseEnd :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipseTotalityBegin :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipseTotalityEnd :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipsePenumbralPhaseBegin :: JulianDayUT1
, LunarEclipseInformation -> JulianDayUT1
lunarEclipsePenumbralPhaseEnd :: JulianDayUT1
} deriving (LunarEclipseInformation -> LunarEclipseInformation -> Bool
(LunarEclipseInformation -> LunarEclipseInformation -> Bool)
-> (LunarEclipseInformation -> LunarEclipseInformation -> Bool)
-> Eq LunarEclipseInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
$c/= :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
== :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
$c== :: LunarEclipseInformation -> LunarEclipseInformation -> Bool
Eq, Int -> LunarEclipseInformation -> FilePath -> FilePath
[LunarEclipseInformation] -> FilePath -> FilePath
LunarEclipseInformation -> FilePath
(Int -> LunarEclipseInformation -> FilePath -> FilePath)
-> (LunarEclipseInformation -> FilePath)
-> ([LunarEclipseInformation] -> FilePath -> FilePath)
-> Show LunarEclipseInformation
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LunarEclipseInformation] -> FilePath -> FilePath
$cshowList :: [LunarEclipseInformation] -> FilePath -> FilePath
show :: LunarEclipseInformation -> FilePath
$cshow :: LunarEclipseInformation -> FilePath
showsPrec :: Int -> LunarEclipseInformation -> FilePath -> FilePath
$cshowsPrec :: Int -> LunarEclipseInformation -> FilePath -> FilePath
Show)
nextLunarEclipseRaw
:: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either String (LunarEclipseType, [Double]))
nextLunarEclipseRaw :: CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, [Double]))
nextLunarEclipseRaw CalcFlag
iflag EclipseFlag
ifltype Bool
backward JulianDayUT1
jd =
(CString -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> (CString -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
Int
-> (Ptr CDouble
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
10 ((Ptr CDouble -> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> (Ptr CDouble
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
ret -> do
CInt
eclType <-
CDouble
-> CalcFlag
-> EclipseFlag
-> Ptr CDouble
-> CInt
-> CString
-> IO CInt
c_swe_lun_eclipse_when
(JulianDayUT1 -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDayUT1
jd)
CalcFlag
iflag
EclipseFlag
ifltype
Ptr CDouble
ret
(Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
backward)
CString
serr
if CInt
eclType CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (LunarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (LunarEclipseType, [Double]))
-> IO FilePath -> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else do
[CDouble]
attrs <- Int -> Ptr CDouble -> IO [CDouble]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
10 Ptr CDouble
ret
case EclipseFlag -> Maybe LunarEclipseType
eclipseFlagToTypeLunar (CInt -> EclipseFlag
EclipseFlag CInt
eclType) of
Maybe LunarEclipseType
Nothing ->
Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> (FilePath -> Either FilePath (LunarEclipseType, [Double]))
-> FilePath
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath (LunarEclipseType, [Double])
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath (LunarEclipseType, [Double])))
-> FilePath -> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown Lunar Eclipse type: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ CInt -> FilePath
forall a. Show a => a -> FilePath
show CInt
eclType
Just LunarEclipseType
set ->
Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> ((LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [Double]))
-> (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [Double])
forall a b. b -> Either a b
Right ((LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double])))
-> (LunarEclipseType, [Double])
-> IO (Either FilePath (LunarEclipseType, [Double]))
forall a b. (a -> b) -> a -> b
$ (LunarEclipseType
set, (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]
attrs)
nextLunarEclipseBuilder
:: (Either String (LunarEclipseType, [Double]) -> Either String a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String a)
nextLunarEclipseBuilder :: (Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a
mkEcl [LunarEclipseType]
typeFilter EventSearchDirection
dir JulianDayUT1
startDate =
Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a
mkEcl (Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> IO (Either FilePath (LunarEclipseType, [Double]))
-> IO (Either FilePath a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CalcFlag
-> EclipseFlag
-> Bool
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, [Double]))
nextLunarEclipseRaw CalcFlag
opts EclipseFlag
eclOpts Bool
backward JulianDayUT1
startDate
where
opts :: CalcFlag
opts = CalcFlag
defaultCalculationFlag
eclOpts :: EclipseFlag
eclOpts =
if [LunarEclipseType] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LunarEclipseType]
typeFilter then
EclipseFlag
anyEclipse
else
[EclipseFlag] -> EclipseFlag
foldEclipseOptions ([EclipseFlag] -> EclipseFlag)
-> ([LunarEclipseType] -> [EclipseFlag])
-> [LunarEclipseType]
-> EclipseFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LunarEclipseType -> EclipseFlag)
-> [LunarEclipseType] -> [EclipseFlag]
forall a b. (a -> b) -> [a] -> [b]
map LunarEclipseType -> EclipseFlag
lunarEclipseTypeToFlag ([LunarEclipseType] -> EclipseFlag)
-> [LunarEclipseType] -> EclipseFlag
forall a b. (a -> b) -> a -> b
$ [LunarEclipseType]
typeFilter
backward :: Bool
backward =
case EventSearchDirection
dir of
EventSearchDirection
SearchBackward -> Bool
True
EventSearchDirection
SearchForward -> Bool
False
nextLunarEclipse :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String LunarEclipseInformation)
nextLunarEclipse :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath LunarEclipseInformation)
nextLunarEclipse =
(Either FilePath (LunarEclipseType, [Double])
-> Either FilePath LunarEclipseInformation)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath LunarEclipseInformation)
forall a.
(Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder
(Either FilePath (LunarEclipseType, [JulianDayUT1])
-> Either FilePath LunarEclipseInformation
mkLunarEcl (Either FilePath (LunarEclipseType, [JulianDayUT1])
-> Either FilePath LunarEclipseInformation)
-> (Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [JulianDayUT1]))
-> Either FilePath (LunarEclipseType, [Double])
-> Either FilePath LunarEclipseInformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LunarEclipseType, [Double])
-> (LunarEclipseType, [JulianDayUT1]))
-> Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, [JulianDayUT1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Double] -> [JulianDayUT1])
-> (LunarEclipseType, [Double])
-> (LunarEclipseType, [JulianDayUT1])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> [a] -> [b]
map ((Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1])
-> (Double -> JulianDayUT1) -> [Double] -> [JulianDayUT1]
forall a b. (a -> b) -> a -> b
$ SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1)))
where
mkLunarEcl :: Either FilePath (LunarEclipseType, [JulianDayUT1])
-> Either FilePath LunarEclipseInformation
mkLunarEcl (Left FilePath
e) = FilePath -> Either FilePath LunarEclipseInformation
forall a b. a -> Either a b
Left FilePath
e
mkLunarEcl (Right (LunarEclipseType
typ, JulianDayUT1
a:JulianDayUT1
_b:JulianDayUT1
c:JulianDayUT1
d:JulianDayUT1
e:JulianDayUT1
f:JulianDayUT1
g:JulianDayUT1
h:[JulianDayUT1]
_)) =
LunarEclipseInformation -> Either FilePath LunarEclipseInformation
forall a b. b -> Either a b
Right (LunarEclipseInformation
-> Either FilePath LunarEclipseInformation)
-> LunarEclipseInformation
-> Either FilePath LunarEclipseInformation
forall a b. (a -> b) -> a -> b
$
LunarEclipseType
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> JulianDayUT1
-> LunarEclipseInformation
LunarEclipseInformation
LunarEclipseType
typ
JulianDayUT1
a
JulianDayUT1
c
JulianDayUT1
d
JulianDayUT1
e
JulianDayUT1
f
JulianDayUT1
g
JulianDayUT1
h
mkLunarEcl Either FilePath (LunarEclipseType, [JulianDayUT1])
_ = FilePath -> Either FilePath LunarEclipseInformation
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
nextLunarEclipseWhen :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either String (LunarEclipseType, JulianDayUT1))
nextLunarEclipseWhen :: [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, JulianDayUT1))
nextLunarEclipseWhen =
(Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, JulianDayUT1))
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath (LunarEclipseType, JulianDayUT1))
forall a.
(Either FilePath (LunarEclipseType, [Double]) -> Either FilePath a)
-> [LunarEclipseType]
-> EventSearchDirection
-> JulianDayUT1
-> IO (Either FilePath a)
nextLunarEclipseBuilder Either FilePath (LunarEclipseType, [Double])
-> Either FilePath (LunarEclipseType, JulianDayUT1)
forall a.
Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax
where
onlyMax :: Either FilePath (a, [Double]) -> Either FilePath (a, JulianDayUT1)
onlyMax (Left FilePath
e) = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
e
onlyMax (Right (a
eclT, Double
jd:[Double]
_)) = (a, JulianDayUT1) -> Either FilePath (a, JulianDayUT1)
forall a b. b -> Either a b
Right (a
eclT, SingTimeStandard 'UT1 -> Double -> JulianDayUT1
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard 'UT1
SUT1 Double
jd)
onlyMax Either FilePath (a, [Double])
_ = FilePath -> Either FilePath (a, JulianDayUT1)
forall a b. a -> Either a b
Left FilePath
"insufficient eclipse data"
directionChangeBetween
:: SingTSI ts
=> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetween :: Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetween =
CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions )
directionChangeBetweenOpt
:: SingTSI ts
=> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt :: CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt =
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
directionChangeBetweenOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
directionChangeBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet JulianDay ts
jdStart JulianDay ts
jdEnd =
let fn :: CDouble -> CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> Ptr CInt -> CString -> IO CInt
fn :: CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_between
SingTimeStandard ts
_ -> CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_ut_between
in (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CDouble
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
dir -> do
CInt
rval <-
CDouble
-> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
(Planet -> PlanetNumber
planetNumber Planet
planet)
CalcFlag
iflag
Ptr CDouble
nextCrossingPtr
Ptr CInt
dir
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, PlanetMotion))
-> IO FilePath -> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else do
CDouble
nextJD <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
CInt
nextDir <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dir
let jd :: JulianDay ts
jd = SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay ts) -> CDouble -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ CDouble
nextJD
rd :: PlanetMotion
rd = if CInt
nextDir CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then PlanetMotion
RetrogradeMotion else PlanetMotion
DirectMotion
Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> ((JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. b -> Either a b
Right ((JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ (JulianDay ts
jd, PlanetMotion
rd)
nextDirectionChange
:: SingTSI ts
=> Planet
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChange :: Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChange =
CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions )
nextDirectionChangeOpt
:: SingTSI ts
=> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt :: CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt =
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
nextDirectionChangeOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either String (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
nextDirectionChangeOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet JulianDay ts
jdStart =
let fn :: CDouble -> PlanetNumber -> CalcFlag -> Ptr CDouble -> Ptr CInt -> CString -> IO CInt
fn :: CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change
SingTimeStandard ts
_ -> CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
c_swe_next_direction_change_ut
in (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (CString -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CDouble
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (Ptr CInt -> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
dir -> do
CInt
rval <-
CDouble
-> PlanetNumber
-> CalcFlag
-> Ptr CDouble
-> Ptr CInt
-> CString
-> IO CInt
fn
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
(Planet -> PlanetNumber
planetNumber Planet
planet)
CalcFlag
iflag
Ptr CDouble
nextCrossingPtr
Ptr CInt
dir
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts, PlanetMotion))
-> IO FilePath -> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else do
CDouble
nextJD <- Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
CInt
nextDir <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
dir
let jd :: JulianDay ts
jd = SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> JulianDay ts) -> CDouble -> JulianDay ts
forall a b. (a -> b) -> a -> b
$ CDouble
nextJD
rd :: PlanetMotion
rd = if CInt
nextDir CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then PlanetMotion
RetrogradeMotion else PlanetMotion
DirectMotion
Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> ((JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JulianDay ts, PlanetMotion)
-> Either FilePath (JulianDay ts, PlanetMotion)
forall a b. b -> Either a b
Right ((JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion)))
-> (JulianDay ts, PlanetMotion)
-> IO (Either FilePath (JulianDay ts, PlanetMotion))
forall a b. (a -> b) -> a -> b
$ (JulianDay ts
jd, PlanetMotion
rd)
crossingBetween
:: SingTSI ts
=> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
crossingBetween :: Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetween =
CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
crossingBetweenOpt
:: SingTSI ts
=> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
crossingBetweenOpt :: CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt =
SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
crossingBetweenOpt'
:: SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
crossingBetweenOpt' :: SingTimeStandard ts
-> CalcFlag
-> Planet
-> Double
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
crossingBetweenOpt' SingTimeStandard ts
sing CalcFlag
iflag Planet
planet Double
lng2Cross JulianDay ts
jdStart JulianDay ts
jdEnd =
let fn :: PlanetNumber -> CDouble -> CDouble -> CDouble -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn :: PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate
SingTimeStandard ts
_ -> PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_ut
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
nextCrossingPtr -> do
CInt
rval <-
PlanetNumber
-> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn
(Planet -> PlanetNumber
planetNumber Planet
planet)
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lng2Cross)
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
CalcFlag
iflag
Ptr CDouble
nextCrossingPtr
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else
JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
nextCrossingPtr
moonPhaseExactAt
:: SingTSI ts
=> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonPhaseExactAt :: LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactAt =
CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTSI ts =>
CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt ([CalcFlag] -> CalcFlag
mkCalculationOptions [CalcFlag]
defaultCalculationOptions)
moonPhaseExactOpt
:: SingTSI ts
=> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonPhaseExactOpt :: CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt =
SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
forall (ts :: TimeStandard).
SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt' SingTimeStandard ts
forall (a :: TimeStandard). SingTSI a => SingTimeStandard a
singTS
moonPhaseExactOpt'
:: SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either String (JulianDay ts))
moonPhaseExactOpt' :: SingTimeStandard ts
-> CalcFlag
-> LunarPhaseName
-> JulianDay ts
-> JulianDay ts
-> IO (Either FilePath (JulianDay ts))
moonPhaseExactOpt' SingTimeStandard ts
sing CalcFlag
iflag LunarPhaseName
lunarPhase JulianDay ts
jdStart JulianDay ts
jdEnd =
let fn :: CDouble -> CDouble -> CDouble -> CalcFlag -> Ptr CDouble -> CString -> IO CInt
fn :: CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn = case SingTimeStandard ts
sing of
SingTimeStandard ts
STT -> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_moon_phase
SingTimeStandard ts
_ -> CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
c_swe_interpolate_moon_phase_ut
in (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall b. (CString -> IO b) -> IO b
allocaErrorMessage ((CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (CString -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \CString
serr ->
(Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts)))
-> (Ptr CDouble -> IO (Either FilePath (JulianDay ts)))
-> IO (Either FilePath (JulianDay ts))
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
phaseExactAt -> do
CInt
rval <-
CDouble
-> CDouble
-> CDouble
-> CalcFlag
-> Ptr CDouble
-> CString
-> IO CInt
fn
(Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble)
-> (LunarPhaseName -> Double) -> LunarPhaseName -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LunarPhaseName -> Double
moonPhaseToAngle (LunarPhaseName -> CDouble) -> LunarPhaseName -> CDouble
forall a b. (a -> b) -> a -> b
$ LunarPhaseName
lunarPhase)
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdStart)
(JulianDay ts -> CDouble
forall (s :: TimeStandard). JulianDay s -> CDouble
jd2C JulianDay ts
jdEnd)
CalcFlag
iflag
Ptr CDouble
phaseExactAt
CString
serr
if CInt
rval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then
FilePath -> Either FilePath (JulianDay ts)
forall a b. a -> Either a b
Left (FilePath -> Either FilePath (JulianDay ts))
-> IO FilePath -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO FilePath
peekCAString CString
serr
else
JulianDay ts -> Either FilePath (JulianDay ts)
forall a b. b -> Either a b
Right (JulianDay ts -> Either FilePath (JulianDay ts))
-> (CDouble -> JulianDay ts)
-> CDouble
-> Either FilePath (JulianDay ts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingTimeStandard ts -> Double -> JulianDay ts
forall (ts :: TimeStandard).
SingTimeStandard ts -> Double -> JulianDay ts
mkJulianDay SingTimeStandard ts
sing (Double -> JulianDay ts)
-> (CDouble -> Double) -> CDouble -> JulianDay ts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CDouble -> Either FilePath (JulianDay ts))
-> IO CDouble -> IO (Either FilePath (JulianDay ts))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CDouble -> IO CDouble
forall a. Storable a => Ptr a -> IO a
peek Ptr CDouble
phaseExactAt