#!/usr/bin/env cabal
{- cabal:
build-depends:
base >= 4.9 && < 6
, bytestring == 0.10.12.1
, http-client == 0.7.17
, lens == 5.3.2
, optparse-applicative == 0.18.1.0
, parsec == 3.1.14.0
, time == 1.9.3
, wreq == 0.5.4.3
-}
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Exception(Exception, catch)
import Control.Lens(view, (&), (.~))
import Data.Bool ( bool )
import Data.ByteString.Lazy ( ByteString )
import Data.Char ( ord )
import Data.List ( sortBy )
import Data.Ord ( comparing )
import Data.Time
( fromGregorian,
addUTCTime,
getCurrentTime,
Day,
UTCTime(utctDay) )
import Network.HTTP.Client(HttpException)
import Network.Wreq(postWith, defaults, headers, Options, Response, responseBody)
import Network.Wreq.Types(FormParam((:=)))
import qualified Data.ByteString.Char8 as Char8(pack)
import Options.Applicative
import System.IO ( stderr, hPutStrLn, hPrint )
import Text.Parsec
( anyChar, digit, string, manyTill, parse, try, ParsecT, Stream )
main ::
IO ()
main =
execParser parserInfoCommandOptions >>= run
airservicesHost ::
String
airservicesHost =
"www.airservicesaustralia.com"
mkAipRequest ::
Exception a =>
(Options -> String -> IO (Response b))
-> String
-> IO (Either a b)
mkAipRequest req s =
let options ::
Options
options =
defaults & headers .~
[
(
"Host"
, Char8.pack airservicesHost
)
, (
"User-Agent"
, "system-f/aip-version"
)
, (
"Accept"
, "*/*"
)
, (
"Accept-Language"
, "en-US,en;q=0.5"
)
, (
"Connection"
, "keep-alive"
)
, (
"DNT"
, "1"
)
]
doRequest =
fmap (Right . view responseBody) (req options ("https://" <> airservicesHost <> "/" <> s))
response =
catch doRequest
(pure . Left)
in response
httpAipIndex ::
IO (Either HttpException ByteString)
httpAipIndex =
mkAipRequest (\o s -> postWith o s ["Submit" := Char8.pack "I Agree", "check" := Char8.pack "1"]) "aip/aip.asp?pg=10"
data PrintCommand =
Latest
| Earliest
| Current
| All
deriving (Eq, Ord, Show)
optParserPrintCommand ::
Parser PrintCommand
optParserPrintCommand =
flag' Latest (long "latest" <> short 'l' <> help "The latest date of an AIP document") <|>
flag' Earliest (long "earliest" <> short 'e' <> help "The earliest date of an AIP document") <|>
flag' Current (long "current" <> short 'c' <> help "The current AIP document using the system date") <|>
flag' All (long "all" <> short 'a' <> help "All AIP documents, separated by a newline")
data CommandOptions =
CommandOptions
PrintCommand
AipDoctype
(Maybe FilePath)
deriving (Eq, Ord, Show)
parserInfoCommandOptions ::
ParserInfo CommandOptions
parserInfoCommandOptions =
let fp =
optional (strOption (long "output-file" <> short 'o' <> help "The output file for the AIP version dates (standard output if omitted)"))
in info
(CommandOptions <$> optParserPrintCommand <*> optParserAipDoctype <*> fp)
(fullDesc <> progDesc "Prints version date(s) from the Aeronautical Information Package (AIP) index page" <> header "aip-version")
parseMonth ::
Stream s m Char =>
ParsecT s u m String
parseMonth =
try (string "JAN") <|>
try (string "FEB") <|>
try (string "MAR") <|>
try (string "APR") <|>
try (string "MAY") <|>
try (string "JUN") <|>
try (string "JUL") <|>
try (string "AUG") <|>
try (string "SEP") <|>
try (string "OCT") <|>
try (string "NOV") <|>
try (string "DEC")
data AipDoctype =
Book
| Charts
| DAP
| ERSA
deriving (Eq, Ord, Show)
optParserAipDoctype ::
Parser AipDoctype
optParserAipDoctype =
flag' Book (long "book" <> help "Match AIP Book documents") <|>
flag' Charts (long "charts" <> help "Match AIP Charts documents") <|>
flag' DAP (long "dap" <> help "Match AIP DAP documents") <|>
flag' ERSA (long "ersa" <> help "Match AIP ERSA documents")
parseAipDoctype ::
Stream s m Char =>
ParsecT s u m AipDoctype
parseAipDoctype =
Book <$ try (string "AIP Book") <|>
Charts <$ try (string "AIP Charts") <|>
DAP <$ try (string "Departure and Approach Procedures (DAP)") <|>
ERSA <$ try (string "En Route Supplement Australia (ERSA)")
data AipDate =
AipDate
Char
Char
String
Char
Char
Char
Char
deriving (Eq, Ord, Show)
parseAipDate ::
Stream s m Char =>
ParsecT s u m AipDate
parseAipDate =
AipDate <$>
digit <*>
digit <*>
parseMonth <*>
digit <*>
digit <*>
digit <*>
digit
showAipDate ::
AipDate
-> String
showAipDate (AipDate d1 d2 m y1 y2 y3 y4) =
[d1, d2] <> m <> [y1, y2, y3, y4]
aipDateDay ::
AipDate
-> Day
aipDateDay (AipDate d1 d2 m y1 y2 y3 y4) =
let ord' x = ord x - 48
m' "JAN" = 1
m' "FEB" = 2
m' "MAR" = 3
m' "APR" = 4
m' "MAY" = 5
m' "JUN" = 6
m' "JUL" = 7
m' "AUG" = 8
m' "SEP" = 9
m' "OCT" = 10
m' "NOV" = 11
m' "DEC" = 12
m' _ = 0
in fromGregorian (toInteger (ord' y1 * 1000 + ord' y2 * 100 + ord' y3 * 10 + ord' y4)) (m' m) (ord' d1 * 10 + ord' d2)
-- |
--
-- >>> parse parseListItem "test" "<li><a href=\"aip.asp?pg=20&vdate=21MAR2024&ver=1\">AIP Book</a> (21 MAR 2024)</li>"
-- Right (Book,AipDate '2' '1' "MAR" '2' '0' '2' '4')
parseListItem ::
Stream s m Char =>
ParsecT s u m (AipDoctype, AipDate)
parseListItem =
do _ <- string "<li>"
_ <- string "<a href=\"aip.asp?pg="
_ <- digit
_ <- digit
_ <- string "&vdate="
d <- parseAipDate
_ <- string "&ver="
_ <- digit
_ <- string "\">"
x <- parseAipDoctype
_ <- string "</a>"
_ <- manyTill anyChar (try (string "</li>"))
pure (x, d)
-- |
--
-- >>> parse parseListItems "test" ""
-- Right []
--
-- >>> parse parseListItems "test" "<li><a href=\"aip.asp?pg=20&vdate=21MAR2024&ver=1\">AIP Book</a> (21 MAR 2024)</li>"
-- Right [(Book,AipDate '2' '1' "MAR" '2' '0' '2' '4')]
--
-- >>> parse parseListItems "test" "<li><a href=\"aip.asp?pg=20&vdate=21MAR2024&ver=1\">AIP Book</a> (21 MAR 2024)</li> abc <li> <li><a href=\"aip.asp?pg=20&vdate=01FEB2022&ver=1\">AIP Charts</a> (21 MAR 2024)</li>"
-- Right [(Book,AipDate '2' '1' "MAR" '2' '0' '2' '4'),(Charts,AipDate '0' '1' "FEB" '2' '0' '2' '2')]
--
-- >>> parse parseListItems "test" "<li> <li<a href <li><a href=\"aip.asp?pg=20&vdate=21MAR2024&ver=1\">AIP Book</a> (21 MAR 2024)</li> abc <li> <li><a href=\"aip.asp?pg=20&vdate=01FEB2022&ver=1\">AIP Charts</a> (21 MAR 2024)</li>"
-- Right [(Book,AipDate '2' '1' "MAR" '2' '0' '2' '4'),(Charts,AipDate '0' '1' "FEB" '2' '0' '2' '2')]
parseListItems ::
Stream s m Char =>
ParsecT s u m [(AipDoctype, AipDate)]
parseListItems =
(try parseListItem >>= \i -> parseListItems >>= \j -> pure (i:j)) <|> try (anyChar *> parseListItems) <|> pure []
run ::
CommandOptions
-> IO ()
run (CommandOptions p a f) =
do q <- httpAipIndex
case fmap (parse parseListItems "run") q of
Left ex ->
hPrint stderr (show ex)
Right (Left pe) ->
hPrint stderr (show pe)
Right (Right x) ->
let dates = (x >>= \(t, d) -> bool [] [d] (a == t))
sortedDates =
sortBy (comparing snd) (fmap (\d -> (d, aipDateDay d)) dates)
fhead [] =
Nothing
fhead ((h,_):_) =
Just h
latest =
fhead (reverse sortedDates)
earliest =
fhead sortedDates
current t =
fhead (dropWhile (\(_, d) -> d > t) (reverse sortedDates))
outputMaybeAipDate Nothing =
hPutStrLn stderr "no data found"
outputMaybeAipDate (Just d) =
output (showAipDate d)
output =
maybe putStr writeFile f
in case p of
Latest ->
outputMaybeAipDate latest
Earliest ->
outputMaybeAipDate earliest
Current ->
getCurrentDayUTC10 >>= outputMaybeAipDate . current
All ->
mapM_ (\(d, _) -> output (showAipDate d)) sortedDates
getCurrentDayUTC10 ::
IO Day
getCurrentDayUTC10 =
fmap (utctDay . addUTCTime 36000) getCurrentTime