{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-imports -Wno-type-defaults -Wno-unused-top-binds #-}
module API.JPL.Horizons (
saveCsv,
Body(..),
) where
import Control.Applicative (Alternative(..))
import Data.Functor (void)
import Data.Void
import Data.List (intercalate, intersperse)
import System.IO (Handle, IOMode(..), withBinaryFile)
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)
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)
import Network.HTTP.Req (runReq, defaultHttpConfig, req, GET(..), Option, Url, Scheme(..), https, (/:), NoReqBody(..), bsResponse, responseBody, (=:) )
import Data.Text (Text)
import Data.Scientific (Scientific)
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Time.Calendar (Day, toGregorian, fromGregorian)
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)
saveCsv :: (Day, Day)
-> Int
-> Body
-> FilePath
-> IO ()
saveCsv :: (Day, Day) -> Int -> Body -> FilePath -> IO ()
saveCsv ds :: (Day, Day)
ds@(Day
d0, Day
d1) Int
dt Body
b FilePath
fdir = do
Builder
bsb <- (Day, Day) -> Int -> Body -> IO Builder
get (Day, Day)
ds Int
dt Body
b
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
get :: (Day, Day) -> Int -> Body -> IO BSB.Builder
get :: (Day, Day) -> Int -> Body -> IO Builder
get (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
$ (Day, Day) -> Int -> Body -> Option 'Https
opts (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 :: (Day, Day) -> Int -> Body -> Option 'Https
opts :: (Day, Day) -> Int -> Body -> Option 'Https
opts (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
"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
data Body = Sun | Mercury | Venus | Earth | Moon | Mars | Jupiter | Saturn | Uranus | Neptune 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
Saturn -> FilePath
"699"
Body
Uranus -> FilePath
"799"
Body
Neptune -> FilePath
"899"
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"
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)
vecCsvHeader :: BSB.Builder
= (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"]
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 :: 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")
header :: Parser ()
= 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 ()
= Tokens ByteString -> ParsecT Void ByteString Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Tokens s -> m ()
PL.skipLineComment Tokens ByteString
"****"
= 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
"*/"