#!/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" "
  • AIP Book (21 MAR 2024)
    • " -- Right (Book,AipDate '2' '1' "MAR" '2' '0' '2' '4') parseListItem :: Stream s m Char => ParsecT s u m (AipDoctype, AipDate) parseListItem = do _ <- string "
  • " _ <- string "" x <- parseAipDoctype _ <- string "" _ <- manyTill anyChar (try (string "
    • ")) pure (x, d) -- | -- -- >>> parse parseListItems "test" "" -- Right [] -- -- >>> parse parseListItems "test" "
  • AIP Book (21 MAR 2024)
    • " -- Right [(Book,AipDate '2' '1' "MAR" '2' '0' '2' '4')] -- -- >>> parse parseListItems "test" "
  • AIP Book (21 MAR 2024)
    • abc
  • AIP Charts (21 MAR 2024)
    • " -- Right [(Book,AipDate '2' '1' "MAR" '2' '0' '2' '4'),(Charts,AipDate '0' '1' "FEB" '2' '0' '2' '2')] -- -- >>> parse parseListItems "test" "
  • AIP Book (21 MAR 2024)
    • abc
  • AIP Charts (21 MAR 2024)
    • " -- 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