aip-version (empty) → 0.0.0.1
raw patch · 5 files changed
+388/−0 lines, 5 filesdep +basedep +bytestringdep +http-clientsetup-changed
Dependencies added: base, bytestring, http-client, lens, optparse-applicative, parsec, time, wreq
Files
- LICENCE +30/−0
- Setup.hs +2/−0
- aip-version.cabal +43/−0
- changelog.md +3/−0
- src/Main.hs +310/−0
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright (c) 2024 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of QFPL nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aip-version.cabal view
@@ -0,0 +1,43 @@+-- documentation, see http://haskell.org/cabal/users-guide/++name: aip-version+version: 0.0.0.1+synopsis: Version of AIP documents+description:+ <<https://system-f.gitlab.io/logo/systemf-450x450.jpg>>+ .+ Zipping with alignment+license: BSD3+license-file: LICENCE+author: Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer: Tony Morris <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright: Copyright (C) 2024 Tony Morris+category: Data+build-type: Simple+extra-source-files: changelog.md+cabal-version: >=1.10+homepage: https://gitlab.com/system-f/code/aip-version+bug-reports: https://gitlab.com/system-f/code/aip-version/issues++source-repository head+ type: git+ location: git@gitlab.com:system-f/code/aip-version.git++executable aip-version+ 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++ main-is: Main.hs++ hs-source-dirs: src++ default-language: Haskell2010++ ghc-options: -Wall
+ changelog.md view
@@ -0,0 +1,3 @@+0.1.0.0++* This change log starts.
+ src/Main.hs view
@@ -0,0 +1,310 @@+#!/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