{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-type-defaults -Wno-unused-top-binds #-}
-- | The JPL Horizons [1] 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.
--
-- 1) https://ssd.jpl.nasa.gov/horizons/
module API.JPL.Horizons (
  saveCsv,
  Body(..),
  Format(..)
  ) where

import Control.Applicative (Alternative(..))
import Data.Functor (void)
import Data.Void
import Data.List (intercalate, intersperse)
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)
import qualified Data.ByteString.Internal as BS (c2w)
import qualified Data.ByteString.Char8 as BS8 (pack)
-- megaparsec
import qualified Text.Megaparsec as P (Parsec, ParseErrorBundle, try, parse, parseTest, some, satisfy, between, skipManyTill, takeWhileP)
import qualified Text.Megaparsec.Error as P (errorBundlePretty)
import qualified Text.Megaparsec.Byte as PL (space1)
import qualified Text.Megaparsec.Byte.Lexer as PL (space, lexeme, symbol, skipLineComment, skipBlockComment, scientific, float, signed)
-- req
import Network.HTTP.Req (runReq, defaultHttpConfig, req, GET(..), Option, Url, Scheme(..), https, (/:), NoReqBody(..), bsResponse, responseBody, (=:) )
import Data.Text (Text)
-- scientific
import Data.Scientific (Scientific)
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 :: Body -> (Day, Day) -> Int -> Body -> Format -> IO ()
saveCsv Body
centerb ds :: (Day, Day)
ds@(Day
d0, Day
d1) Int
dt Body
b Format
format = do
  Builder
bsb <- Body -> (Day, Day) -> Int -> Body -> IO Builder
get Body
centerb (Day, Day)
ds Int
dt Body
b
  case Format
format of
    Format
StdOut -> do
      Handle -> Builder -> IO ()
BSB.hPutBuilder Handle
stdout Builder
bsb
    ToCSV FilePath
fdir -> do
      let
        fpath :: FilePath
fpath = FilePath
fdir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [FilePath] -> FilePath
forall a. Monoid a => [a] -> a
mconcat (FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
intersperse FilePath
"_" [Body -> FilePath
forall a. Show a => a -> FilePath
show Body
b, Day -> FilePath
time Day
d0, Day -> FilePath
time Day
d1]) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
".csv"
      FilePath -> Builder -> IO ()
bsbWriteFile FilePath
fpath Builder
bsb

-- | Output format
data Format = StdOut
            | ToCSV FilePath

bsbWriteFile :: FilePath -> BSB.Builder -> IO ()
bsbWriteFile :: FilePath -> Builder -> IO ()
bsbWriteFile = IOMode -> FilePath -> Builder -> IO ()
modifyFile IOMode
WriteMode
modifyFile :: IOMode -> FilePath -> BSB.Builder -> IO ()
modifyFile :: IOMode -> FilePath -> Builder -> IO ()
modifyFile IOMode
mode FilePath
f Builder
bld = FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
f IOMode
mode (Handle -> Builder -> IO ()
`BSB.hPutBuilder` Builder
bld)

-- | Make an API call
get :: Body -> (Day, Day) -> Int -> Body -> IO BSB.Builder
get :: Body -> (Day, Day) -> Int -> Body -> IO Builder
get Body
centerb (Day, Day)
ds Int
dt Body
b = do
  ByteString
bs <- Option 'Https -> IO ByteString
get0 (Option 'Https -> IO ByteString) -> Option 'Https -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Body -> (Day, Day) -> Int -> Body -> Option 'Https
opts Body
centerb (Day, Day)
ds Int
dt Body
b
  case Parsec Void ByteString [Vec]
-> FilePath
-> ByteString
-> Either (ParseErrorBundle ByteString Void) [Vec]
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec Void ByteString [Vec]
vectors FilePath
"" ByteString
bs of
    Right [Vec]
vs -> Builder -> IO Builder
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> IO Builder) -> Builder -> IO Builder
forall a b. (a -> b) -> a -> b
$
                  Builder
vecCsvHeader Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                  (Vec -> Builder) -> [Vec] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Vec -> Builder
vecCsvBuilder [Vec]
vs
    Left ParseErrorBundle ByteString Void
e -> FilePath -> IO Builder
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO Builder) -> FilePath -> IO Builder
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle ByteString Void -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
P.errorBundlePretty ParseErrorBundle ByteString Void
e

get0 :: Option 'Https -> IO BS.ByteString
get0 :: Option 'Https -> IO ByteString
get0 Option 'Https
os = HttpConfig -> Req ByteString -> IO ByteString
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (Req ByteString -> IO ByteString)
-> Req ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
  BsResponse
r <- GET
-> Url 'Https
-> NoReqBody
-> Proxy BsResponse
-> Option 'Https
-> Req BsResponse
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
endpoint NoReqBody
NoReqBody Proxy BsResponse
bsResponse Option 'Https
os
  ByteString -> Req ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Req ByteString) -> ByteString -> Req ByteString
forall a b. (a -> b) -> a -> b
$ BsResponse -> HttpResponseBody BsResponse
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody BsResponse
r

opts :: Body -> (Day, Day) -> Int -> Body -> Option 'Https
opts :: Body -> (Day, Day) -> Int -> Body -> Option 'Https
opts Body
cb (Day
d0, Day
d1) Int
dt Body
b =
  Text
"format" Text -> FilePath -> Option 'Https
==: FilePath
"text" Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"make_ephem" Text -> FilePath -> Option 'Https
==: FilePath
"yes" Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"ephem_type" Text -> FilePath -> Option 'Https
==: FilePath
"vectors" Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"center" Text -> FilePath -> Option 'Https
==: Body -> FilePath
forall c. IsBody c => c -> FilePath
bodyToCommand Body
cb Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"command" Text -> FilePath -> Option 'Https
==: Body -> FilePath
forall c. IsBody c => c -> FilePath
bodyToCommand Body
b Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"obj_data" Text -> FilePath -> Option 'Https
==: FilePath
"no" Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"ref_system" Text -> FilePath -> Option 'Https
==: FilePath
"icrf" Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"start_time" Text -> FilePath -> Option 'Https
==: Day -> FilePath
time Day
d0 Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"stop_time" Text -> FilePath -> Option 'Https
==: Day -> FilePath
time Day
d1 Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<>
  Text
"step_size" Text -> FilePath -> Option 'Https
==: Int -> FilePath
stepsizeMins Int
dt

{-
    [id: 10]   Sun [Sol]
    [id:199]   Mercury
    [id:299]   Venus
    [id:399]   Earth
    [id:301]   Moon
    [id:499]   Mars
    [id:599]   Jupiter
    [id:699]   Saturn
    [id:799]   Uranus
    [id:899]   Neptune
-}

-- | Large bodies in the Solar System
data Body = Sun
          | Mercury
          | Venus
          | Earth | Moon
          | Mars
          | Jupiter | Io | Europa | Ganymede | Callisto | Amalthea
          | Saturn | Mimas | Enceladus | Tethys | Dione | Rhea | Titan | Hyperion | Iapetus | Phoebe | Janus | Epimetheus
          | Uranus
          | Neptune | Triton
          | Pluto
          | Eris
          deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c== :: Body -> Body -> Bool
Eq, Int -> Body -> FilePath -> FilePath
[Body] -> FilePath -> FilePath
Body -> FilePath
(Int -> Body -> FilePath -> FilePath)
-> (Body -> FilePath)
-> ([Body] -> FilePath -> FilePath)
-> Show Body
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Body] -> FilePath -> FilePath
$cshowList :: [Body] -> FilePath -> FilePath
show :: Body -> FilePath
$cshow :: Body -> FilePath
showsPrec :: Int -> Body -> FilePath -> FilePath
$cshowsPrec :: Int -> Body -> FilePath -> FilePath
Show, Int -> Body
Body -> Int
Body -> [Body]
Body -> Body
Body -> Body -> [Body]
Body -> Body -> Body -> [Body]
(Body -> Body)
-> (Body -> Body)
-> (Int -> Body)
-> (Body -> Int)
-> (Body -> [Body])
-> (Body -> Body -> [Body])
-> (Body -> Body -> [Body])
-> (Body -> Body -> Body -> [Body])
-> Enum Body
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Body -> Body -> Body -> [Body]
$cenumFromThenTo :: Body -> Body -> Body -> [Body]
enumFromTo :: Body -> Body -> [Body]
$cenumFromTo :: Body -> Body -> [Body]
enumFromThen :: Body -> Body -> [Body]
$cenumFromThen :: Body -> Body -> [Body]
enumFrom :: Body -> [Body]
$cenumFrom :: Body -> [Body]
fromEnum :: Body -> Int
$cfromEnum :: Body -> Int
toEnum :: Int -> Body
$ctoEnum :: Int -> Body
pred :: Body -> Body
$cpred :: Body -> Body
succ :: Body -> Body
$csucc :: Body -> Body
Enum)

class IsBody c where
  bodyToCommand :: c -> String
instance IsBody Body where
  bodyToCommand :: Body -> FilePath
bodyToCommand = \case
    Body
Sun -> FilePath
"10"
    Body
Mercury -> FilePath
"199"
    Body
Venus -> FilePath
"299"
    Body
Earth -> FilePath
"399"
    Body
Moon -> FilePath
"301"
    Body
Mars -> FilePath
"499"
    Body
Jupiter -> FilePath
"599"
    Body
Io -> FilePath
"501"
    Body
Europa -> FilePath
"502"
    Body
Ganymede -> FilePath
"503"
    Body
Callisto -> FilePath
"504"
    Body
Amalthea -> FilePath
"505"
    Body
Saturn -> FilePath
"699"
    Body
Mimas -> FilePath
"601"
    Body
Enceladus -> FilePath
"602"
    Body
Tethys -> FilePath
"603"
    Body
Dione -> FilePath
"604"
    Body
Rhea -> FilePath
"605"
    Body
Titan -> FilePath
"606"
    Body
Hyperion -> FilePath
"607"
    Body
Iapetus -> FilePath
"608"
    Body
Phoebe -> FilePath
"609"
    Body
Janus -> FilePath
"610"
    Body
Epimetheus -> FilePath
"611"
    Body
Uranus -> FilePath
"799"
    Body
Neptune -> FilePath
"899"
    Body
Triton -> FilePath
"801"
    Body
Pluto -> FilePath
"999"
    Body
Eris -> FilePath
"136199"

stepsizeMins :: Int -> String
stepsizeMins :: Int -> FilePath
stepsizeMins Int
m = Int -> FilePath
forall a. Show a => a -> FilePath
show Int
m FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"m"

time :: Day -> String
time :: Day -> FilePath
time Day
d = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"-" [Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
yy, Int -> FilePath
forall a. Show a => a -> FilePath
show Int
mm, Int -> FilePath
forall a. Show a => a -> FilePath
show Int
dd]
  where
    (Integer
yy, Int
mm, Int
dd) = Day -> (Integer, Int, Int)
toGregorian Day
d

(==:) :: Text -> String -> Option 'Https
==: :: Text -> FilePath -> Option 'Https
(==:) = Text -> FilePath -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
(=:)

endpoint :: Url 'Https
endpoint :: Url 'Https
endpoint = Text -> Url 'Https
https Text
"ssd.jpl.nasa.gov" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"api" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"horizons.api"

{-
2453736.500000000 = A.D. 2006-Jan-01 00:00:00.0000 TDB 
 X = 8.749529331045696E+07 Y = 7.604048145779434E+07 Z = 3.126488404274795E+06
 VX= 7.367178825395701E+00 VY= 1.398625134891928E+01 VZ= 7.299094429880579E-01
 LT= 3.868100505438247E+02 RG= 1.159627358316374E+08 RR= 1.474953828661886E+01
-}


vectors :: Parser [Vec]
vectors :: Parsec Void ByteString [Vec]
vectors = ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some ParsecT Void ByteString Identity ()
header ParsecT Void ByteString Identity [()]
-> Parsec Void ByteString [Vec] -> Parsec Void ByteString [Vec]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void ByteString [Vec] -> Parsec Void ByteString [Vec]
forall a. Parser a -> Parser a
payload (ParsecT Void ByteString Identity Vec
-> Parsec Void ByteString [Vec]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.some ParsecT Void ByteString Identity Vec
vec)

data Vec = Vec Scientific Scientific Scientific Scientific Scientific Scientific deriving (Int -> Vec -> FilePath -> FilePath
[Vec] -> FilePath -> FilePath
Vec -> FilePath
(Int -> Vec -> FilePath -> FilePath)
-> (Vec -> FilePath) -> ([Vec] -> FilePath -> FilePath) -> Show Vec
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Vec] -> FilePath -> FilePath
$cshowList :: [Vec] -> FilePath -> FilePath
show :: Vec -> FilePath
$cshow :: Vec -> FilePath
showsPrec :: Int -> Vec -> FilePath -> FilePath
$cshowsPrec :: Int -> Vec -> FilePath -> FilePath
Show)

-- | CSV Header
vecCsvHeader :: BSB.Builder
vecCsvHeader :: Builder
vecCsvHeader = (FilePath -> Builder) -> [FilePath] -> Builder
forall t. (t -> Builder) -> [t] -> Builder
csvBuild FilePath -> Builder
BSB.string8 [FilePath
"X", FilePath
"Y", FilePath
"Z", FilePath
"VX", FilePath
"VY", FilePath
"VZ"]
-- | CSV data row
vecCsvBuilder :: Vec -> BSB.Builder
vecCsvBuilder :: Vec -> Builder
vecCsvBuilder (Vec Scientific
v0x Scientific
v0y Scientific
v0z Scientific
vvx Scientific
vvy Scientific
vvz) =
  (Scientific -> Builder) -> [Scientific] -> Builder
forall t. (t -> Builder) -> [t] -> Builder
csvBuild Scientific -> Builder
scientificBuilder [Scientific
v0x, Scientific
v0y, Scientific
v0z, Scientific
vvx, Scientific
vvy, Scientific
vvz]

csvBuild :: (t -> BSB.Builder) -> [t] -> BSB.Builder
csvBuild :: (t -> Builder) -> [t] -> Builder
csvBuild t -> Builder
_ [] = Builder
forall a. Monoid a => a
mempty
csvBuild t -> Builder
bfun (t
w:[t]
ws) = t -> Builder
bfun t
w Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [t] -> Builder
go [t]
ws
  where
    go :: [t] -> Builder
go (t
m:[t]
ms) = FilePath -> Builder
BSB.string8 FilePath
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> t -> Builder
bfun t
m Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [t] -> Builder
go [t]
ms
    go [] = FilePath -> Builder
BSB.string8 FilePath
"\n"


-- | timestamp line e.g.
--
-- 2453736.500000000 = A.D. 2006-Jan-01 00:00:00.0000 TDB
timestamp :: Parser ()
timestamp :: ParsecT Void ByteString Identity ()
timestamp = ParsecT Void ByteString Identity Double
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, RealFloat a) =>
m a
PL.float ParsecT Void ByteString Identity Double
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1 ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"= A.D."

vec :: Parser Vec
vec :: ParsecT Void ByteString Identity Vec
vec = do
  ParsecT Void ByteString Identity ()
timestamp
  Scientific
cx <- Parser Scientific
x Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
cy <- Parser Scientific
y Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
cz <- Parser Scientific
z Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
cvx <- Parser Scientific
vx Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
cvy <- Parser Scientific
vy Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
cvz <- Parser Scientific
vz Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
_ <- Parser Scientific
lt Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
_ <- Parser Scientific
rg Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Scientific
_ <- Parser Scientific
rr Parser Scientific
-> ParsecT Void ByteString Identity () -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1
  Vec -> ParsecT Void ByteString Identity Vec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vec -> ParsecT Void ByteString Identity Vec)
-> Vec -> ParsecT Void ByteString Identity Vec
forall a b. (a -> b) -> a -> b
$ Scientific
-> Scientific
-> Scientific
-> Scientific
-> Scientific
-> Scientific
-> Vec
Vec Scientific
cx Scientific
cy Scientific
cz Scientific
cvx Scientific
cvy Scientific
cvz

x, y, z, vx, vy, vz, lt, rg, rr :: Parser Scientific
x :: Parser Scientific
x = FilePath -> Parser Scientific
vcomp FilePath
"X"
y :: Parser Scientific
y = FilePath -> Parser Scientific
vcomp FilePath
"Y"
z :: Parser Scientific
z = FilePath -> Parser Scientific
vcomp FilePath
"Z"
vx :: Parser Scientific
vx = FilePath -> Parser Scientific
vcomp FilePath
"VX"
vy :: Parser Scientific
vy = FilePath -> Parser Scientific
vcomp FilePath
"VY"
vz :: Parser Scientific
vz = FilePath -> Parser Scientific
vcomp FilePath
"VZ"
lt :: Parser Scientific
lt = FilePath -> Parser Scientific
vcomp FilePath
"LT"
rg :: Parser Scientific
rg = FilePath -> Parser Scientific
vcomp FilePath
"RG"
rr :: Parser Scientific
rr = FilePath -> Parser Scientific
vcomp FilePath
"RR"

vcomp :: String -> Parser Scientific
vcomp :: FilePath -> Parser Scientific
vcomp FilePath
vv = ByteString -> Parser ByteString
psymbol (FilePath -> ByteString
BS8.pack FilePath
vv) Parser ByteString -> Parser ByteString -> Parser ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> Parser ByteString
psymbol ByteString
"=" Parser ByteString -> Parser Scientific -> Parser Scientific
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Scientific
scientific

scientific :: Parser Scientific
scientific :: Parser Scientific
scientific = ParsecT Void ByteString Identity ()
-> Parser Scientific -> Parser Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
PL.signed ParsecT Void ByteString Identity ()
space Parser Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
PL.scientific

payload :: Parser a -> Parser a
payload :: Parser a -> Parser a
payload = Parser ByteString -> Parser ByteString -> Parser a -> Parser a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (ByteString -> Parser ByteString
psymbol ByteString
"$$SOE") (ByteString -> Parser ByteString
psymbol ByteString
"$$EOE")

-- payloadDelim :: Parser ()
-- payloadDelim = void $ psymbol "$$SOE"

header :: Parser ()
header :: ParsecT Void ByteString Identity ()
header = FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Ephemeris" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"API" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Target" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Center" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Output" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"EOP" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Start" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Stop" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Step" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Reference" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"JDTDB" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"X" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Y" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"Z" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"VX" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"VY" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"VZ" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"LT" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"RG" ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
"RR"

skipLine :: String -> Parser ()
skipLine :: FilePath -> ParsecT Void ByteString Identity ()
skipLine FilePath
s = ByteString -> Parser ByteString
psymbol (FilePath -> ByteString
BS8.pack FilePath
s) Parser ByteString
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
             Parser ByteString -> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe FilePath
-> (Token ByteString -> Bool)
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe FilePath -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"") (\Token ByteString
c -> Word8
Token ByteString
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
BS.c2w Char
'\n')) ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
             Parser ByteString -> ParsecT Void ByteString Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Parser ByteString
psymbol (ByteString
"\n"))

type Parser = P.Parsec Void BS.ByteString
type ParseErrorBundle = P.ParseErrorBundle BS.ByteString Void


psymbol :: BS.ByteString -> Parser BS.ByteString
psymbol :: ByteString -> Parser ByteString
psymbol = ParsecT Void ByteString Identity ()
-> Tokens ByteString
-> ParsecT Void ByteString Identity (Tokens ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
PL.symbol ParsecT Void ByteString Identity ()
space

space :: Parser ()
space :: ParsecT Void ByteString Identity ()
space = ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> m () -> m () -> m ()
PL.space ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
PL.space1 ParsecT Void ByteString Identity ()
lineComment ParsecT Void ByteString Identity ()
blockComment

lineComment, blockComment :: Parser ()
lineComment :: ParsecT Void ByteString Identity ()
lineComment = Tokens ByteString -> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s -> m ()
PL.skipLineComment Tokens ByteString
"****"

blockComment :: ParsecT Void ByteString Identity ()
blockComment = Tokens ByteString
-> Tokens ByteString -> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s -> Tokens s -> m ()
PL.skipBlockComment Tokens ByteString
"/**" Tokens ByteString
"*/"