diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -7,14 +7,14 @@ -- time import Data.Time.Calendar (Day, toGregorian, fromGregorian) -import API.JPL.Horizons (saveCsv, Body(..)) +import API.JPL.Horizons (saveCsv, Body(..), Format(..)) main :: IO () main = do - (Cfg d0 d1 r bdy) <- customExecParser (prefs showHelpOnError) opts - saveCsv (d0, d1) r bdy "data" + (Cfg cbody d0 d1 r bdy fmt) <- customExecParser (prefs showHelpOnError) opts + saveCsv cbody (d0, d1) r bdy fmt opts :: ParserInfo Cfg @@ -24,19 +24,38 @@ <> header "jpl-horizons-api - download ephemerides in CSV format" ) data Cfg = Cfg { - cfgDay0 :: Day + cfgCenterBody :: Body + , cfgDay0 :: Day , cfgDay1 :: Day , cfgResolnMin :: Int - , cfgBody :: Body + , cfgBody :: Body + , cfgFormat :: Format } cfgP :: Parser Cfg cfgP = Cfg <$> + centerBodyP <*> day0P <*> day1P <*> resolnP <*> - bodyP + bodyP <*> + formatP +formatP :: Parser Format +formatP = stdOutP <|> + toCsvP + +stdOutP :: Parser Format +stdOutP = flag' StdOut (long "stdout") + +toCsvP :: Parser Format +toCsvP = ToCSV <$> strOption ( + long "outout-directory" <> + short 'o' <> + value "data" <> + showDefault + ) + resolnP :: Parser Int resolnP = option auto (long "resolution" <> metavar "MINUTES" <> @@ -55,8 +74,19 @@ option auto (long "month_stop" <> value 1 <> showDefault) <*> option auto (long "day_stop" <> value 1 <> showDefault) + +centerBodyP :: Parser Body +centerBodyP = flag' Sun (long "sun") <|> + flag' Earth (long "earth") + bodyP :: Parser Body bodyP = flag' Sun (long "sun") <|> flag' Mercury (long "mercury") <|> flag' Venus (long "venus") <|> - flag' Earth (long "earth") + flag' Earth (long "earth") <|> + flag' Moon (long "moon") <|> + flag' Mars (long "mars") <|> + flag' Jupiter (long "jupiter") <|> + flag' Saturn (long "saturn") <|> + flag' Uranus (long "uranus") <|> + flag' Pluto (long "pluto") diff --git a/jpl-horizons-api.cabal b/jpl-horizons-api.cabal --- a/jpl-horizons-api.cabal +++ b/jpl-horizons-api.cabal @@ -1,7 +1,9 @@ name: jpl-horizons-api -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Ephemerides for solar system objects from the JPL Horizons service description: The JPL Horizons on-line solar system data and ephemeris computation service provides access to key solar system data and flexible production of highly accurate ephemerides for solar system objects (1,180,796 asteroids, 3,789 comets, 211 planetary satellites {includes satellites of Earth and dwarf planet Pluto}, 8 planets, the Sun, L1, L2, select spacecraft, and system barycenters). Horizons is provided by the Solar System Dynamics Group of the Jet Propulsion Laboratory. + . + This package provides a convenience function for downloading select intervals of ephemeris data, and saving the state vector as a CSV file. homepage: https://github.com/ocramz/jpl-horizons-api license: BSD3 license-file: LICENSE diff --git a/src/API/JPL/Horizons.hs b/src/API/JPL/Horizons.hs --- a/src/API/JPL/Horizons.hs +++ b/src/API/JPL/Horizons.hs @@ -10,16 +10,15 @@ module API.JPL.Horizons ( saveCsv, Body(..), - -- -- * CSV export - -- vecCsvBuilder, vecCsvHeader, - -- bsbWriteFile + Format(..) ) where import Control.Applicative (Alternative(..)) import Data.Functor (void) import Data.Void import Data.List (intercalate, intersperse) -import System.IO (Handle, IOMode(..), withBinaryFile) +import System.IO (Handle, IOMode(..), stdout, withBinaryFile) + -- bytestring import qualified Data.ByteString as BS (ByteString) import qualified Data.ByteString.Builder as BSB (Builder, toLazyByteString, hPutBuilder, char8, string8) @@ -38,30 +37,41 @@ import Data.ByteString.Builder.Scientific (scientificBuilder) -- time import Data.Time.Calendar (Day, toGregorian, fromGregorian) +import Data.Time.Clock (DiffTime) +-- | Make an API call, parse and save the results as CSV +-- +-- The resulting file will contain one sample of the state vector per row +saveCsv :: Body -- ^ center body (observation site) + -> (Day, Day) -- ^ (first, last) day of observation + -> Int -- ^ observation interval in minutes + -> Body -- ^ solar system body + -> Format -- ^ Output format + -> IO () +saveCsv centerb ds@(d0, d1) dt b format = do + bsb <- get centerb ds dt b + case format of + StdOut -> do + BSB.hPutBuilder stdout bsb + ToCSV fdir -> do + let + fpath = fdir <> "/" <> mconcat (intersperse "_" [show b, time d0, time d1]) <> ".csv" + bsbWriteFile fpath bsb +-- | Output format +data Format = StdOut + | ToCSV FilePath + bsbWriteFile :: FilePath -> BSB.Builder -> IO () bsbWriteFile = modifyFile WriteMode modifyFile :: IOMode -> FilePath -> BSB.Builder -> IO () modifyFile mode f bld = withBinaryFile f mode (`BSB.hPutBuilder` bld) --- | Make an API call, parse and save the results as CSV -saveCsv :: (Day, Day) -- ^ (first, last) day of observation - -> Int -- ^ observation interval in minutes - -> Body -- ^ solar system body - -> FilePath -- ^ CSV directory path - -> IO () -saveCsv ds@(d0, d1) dt b fdir = do - bsb <- get ds dt b - let - fpath = fdir <> "/" <> mconcat (intersperse "_" [show b, time d0, time d1]) <> ".csv" - bsbWriteFile fpath bsb - --- | Run an API call -get :: (Day, Day) -> Int -> Body -> IO BSB.Builder -get ds dt b = do - bs <- get0 $ opts ds dt b +-- | Make an API call +get :: Body -> (Day, Day) -> Int -> Body -> IO BSB.Builder +get centerb ds dt b = do + bs <- get0 $ opts centerb ds dt b case P.parse vectors "" bs of Right vs -> pure $ vecCsvHeader <> @@ -73,11 +83,12 @@ r <- req GET endpoint NoReqBody bsResponse os pure $ responseBody r -opts :: (Day, Day) -> Int -> Body -> Option 'Https -opts (d0, d1) dt b = +opts :: Body -> (Day, Day) -> Int -> Body -> Option 'Https +opts cb (d0, d1) dt b = "format" ==: "text" <> "make_ephem" ==: "yes" <> "ephem_type" ==: "vectors" <> + "center" ==: bodyToCommand cb <> "command" ==: bodyToCommand b <> "obj_data" ==: "no" <> "ref_system" ==: "icrf" <>