From 68939455a2d47482243b13a8157adf8411d8e002 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Thu, 25 Nov 2021 17:25:47 -0500 Subject: [PATCH 1/5] support base 4.16 (ghc 9.2.1) --- package.yaml | 2 +- swiss-ephemeris.cabal | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/package.yaml b/package.yaml index fadf4cf..7b4bbdc 100644 --- a/package.yaml +++ b/package.yaml @@ -21,7 +21,7 @@ category: Data, Astrology description: Please see the README on GitHub at dependencies: -- base >= 4.10 && < 4.16 +- base >= 4.10 && < 4.17 - vector >= 0.12 && < 0.13 - time >= 1.9 && < 1.13 diff --git a/swiss-ephemeris.cabal b/swiss-ephemeris.cabal index e6b5350..3d96880 100644 --- a/swiss-ephemeris.cabal +++ b/swiss-ephemeris.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 1f78f55bc113fd41d97119660086ed24ad498a24fc93d13d8e09a0449e0e3e60 +-- hash: 0ce263f1e5ae501c5cc0ea1a7855a10c869263c48fa08be997f1876116c9c6e0 name: swiss-ephemeris version: 1.4.0.0 @@ -79,7 +79,7 @@ library csrc/configurable_sweephe4.c csrc/interpolate.c build-depends: - base >=4.10 && <4.16 + base >=4.10 && <4.17 , time >=1.9 && <1.13 , vector >=0.12 && <0.13 default-language: Haskell2010 @@ -102,7 +102,7 @@ test-suite swiss-ephemeris-test hspec-discover:hspec-discover >=2.7 && <2.8 build-depends: QuickCheck >=2.12 && <=2.15 - , base >=4.10 && <4.16 + , base >=4.10 && <4.17 , directory >=1.3 && <1.4 , hspec >=2.7 && <2.8 , random From 315bab9c6e3726e62407740a8a709e9c7a998f82 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Thu, 25 Nov 2021 17:31:09 -0500 Subject: [PATCH 2/5] update changelog --- ChangeLog.md | 1 + 1 file changed, 1 insertion(+) diff --git a/ChangeLog.md b/ChangeLog.md index 55be61e..98ec88c 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -4,6 +4,7 @@ * Export `utcToJulianDays`, to obtain a product of `(TT, UT1)` Julian Days from a `UTCTime` value -- saves you one IO trip vs. getting them separately. +* Support for GHC 9.2.1 ## v1.4.0.0 (2021-11-11) From 18ab38fa3646942afdea48a82e180e7a593f2643 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Thu, 25 Nov 2021 17:37:22 -0500 Subject: [PATCH 3/5] update version, actually add 9.2.1 to test matrix --- .github/workflows/haskell.yml | 2 +- package.yaml | 2 +- swiss-ephemeris.cabal | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index a82e4ae..6d4d7d8 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -12,7 +12,7 @@ jobs: strategy: fail-fast: false matrix: - ghc: ['8.2.2', '8.4.4', '8.6.5', '8.8.3', '8.10.4', '9.0.1'] + ghc: ['8.2.2', '8.4.4', '8.6.5', '8.8.3', '8.10.4', '9.0.1', '9.2.1'] cabal: ['3.2'] os: [ubuntu-latest, macos-latest] env: diff --git a/package.yaml b/package.yaml index 7b4bbdc..8040966 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: swiss-ephemeris -version: 1.4.0.0 +version: 1.4.1.0 github: "lfborjas/swiss-ephemeris" license: AGPL-3 author: "Luis Borjas Reyes" diff --git a/swiss-ephemeris.cabal b/swiss-ephemeris.cabal index 3d96880..b4c4bfa 100644 --- a/swiss-ephemeris.cabal +++ b/swiss-ephemeris.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 0ce263f1e5ae501c5cc0ea1a7855a10c869263c48fa08be997f1876116c9c6e0 +-- hash: 0feead7e44aba9915159eab5ab88bf44fc083266e7fbefe092fe08f1572f95b2 name: swiss-ephemeris -version: 1.4.0.0 +version: 1.4.1.0 synopsis: Haskell bindings for the Swiss Ephemeris C library description: Please see the README on GitHub at category: Data, Astrology From 11444a35a7d0fc928600401e8da4f6449cc623c4 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 26 Nov 2021 11:04:07 -0500 Subject: [PATCH 4/5] make direction changes friendlier to edge cases The underlying C function will fail to find a direction change if one starts looking less than 30 mins before it happens; for the bounded lookup, we'd like to not have to sweat that, so I made the C function a bit uglier to make the Haskell interface a bit prettier. --- csrc/interpolate.c | 21 ++++++++++++++------- test/SwissEphemerisSpec.hs | 7 +++++++ 2 files changed, 21 insertions(+), 7 deletions(-) diff --git a/csrc/interpolate.c b/csrc/interpolate.c index da338d8..da52cf7 100644 --- a/csrc/interpolate.c +++ b/csrc/interpolate.c @@ -43,18 +43,24 @@ int swe_next_direction_change(double jd0, int ipl, int iflag, double *jdx, int * ); } +// modified version of fn shared by Alois in: https://groups.io/g/swisseph/message/7781 int swe_next_direction_change_between(double jd0, double jd_end, int ipl, int iflag, double *jdx, int *idir, char *serr) { double jd_step = 1; - double xx[6], d1, d2, y0, y1, y2, a, b, jd, tx; + double xx[6], d1, d2, y0, y1, y2, a, b, jd, tx, orig_start, orig_end; int rval, is; if (jd_step <= 0) jd_step = 1.0; - // NOTE(luis) adding a couple of days to the end of the search since 3 positions - // are needed for interpolation, at least. - double orig_end = jd_end; + // NOTE(luis) adding some padding to the beginning and end since intervals that are too + // small won't produce the 3 points necessary for parabolic interpolation; + // also, as noted by Alois, the `jd0` moment must be at least 30 mins before + // the actual occurrence. + orig_start = jd0; + orig_end = jd_end; + jd0 -= 1; if (fabs(jd_end - jd0) < 3){ jd_end += 3; } + // end of ugliness rval = swe_calc(jd0, ipl, iflag, xx, serr); if (rval < 0) return rval; y0 = xx[0]; @@ -107,15 +113,16 @@ int swe_next_direction_change_between(double jd0, double jd_end, int ipl, int if *idir = 1; else *idir = -1; - if (*jdx > orig_end){ - sprintf(serr, "swe_next_direction_change: no change within %lf days", (orig_end - jd0)); + // NOTE(luis) compensate for the fake bounds created for parabolic approximation + if (*jdx > orig_end || *jdx < orig_start){ + sprintf(serr, "swe_next_direction_change: no change within %lf days", (orig_end - orig_start)); return ERR; } return rval; } // come here only if no change found in loop if (serr != NULL) - sprintf(serr, "swe_next_direction_change: no change within %lf days", (orig_end - jd0)); + sprintf(serr, "swe_next_direction_change: no change within %lf days", (orig_end - orig_start)); return ERR; } diff --git a/test/SwissEphemerisSpec.hs b/test/SwissEphemerisSpec.hs index 05a54f4..2f9d4ba 100644 --- a/test/SwissEphemerisSpec.hs +++ b/test/SwissEphemerisSpec.hs @@ -314,6 +314,13 @@ spec = do getJulianDay crossingJD `shouldBe` expectedCrossing motion `shouldBe` expectedMotion + it "calculates a known direction change happening less than 30 mins after lookup starts" $ do + let startJD = mkJulianDay STT 2459266.500800741 + endJD = mkJulianDay STT 2459267.500800741 + Right (crossingJD, motion) <- directionChangeBetween Mercury startJD endJD + getJulianDay crossingJD `shouldBe` 2459266.536910611 + motion `shouldBe` DirectMotion + it "fails to calculate direction change if outside of the interval" $ do let startTime = mkJulian 2021 7 14 0.0 endTime = mkJulian 2021 7 15 0.0 From 17ad66f7d0884ccc17aeb9a559ef4335032e2ee0 Mon Sep 17 00:00:00 2001 From: Luis Borjas Reyes Date: Fri, 26 Nov 2021 11:07:03 -0500 Subject: [PATCH 5/5] update changelog --- ChangeLog.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ChangeLog.md b/ChangeLog.md index 98ec88c..1e47be4 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -5,6 +5,8 @@ * Export `utcToJulianDays`, to obtain a product of `(TT, UT1)` Julian Days from a `UTCTime` value -- saves you one IO trip vs. getting them separately. * Support for GHC 9.2.1 +* Fix minor bug in `directionChange` that made lookups starting <=30 minutes before the event fail + (due to an artifact of the original C function that explicitly excludes such lookup bounds.) ## v1.4.0.0 (2021-11-11)