diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/aip-version.cabal b/aip-version.cabal new file mode 100644 --- /dev/null +++ b/aip-version.cabal @@ -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: + <> + . + Zipping with alignment +license: BSD3 +license-file: LICENCE +author: Tony Morris +maintainer: Tony Morris +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 diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,3 @@ +0.1.0.0 + +* This change log starts. diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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" "
  • 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