metar-http 0.0.4 → 0.0.5
raw patch · 5 files changed
+185/−179 lines, 5 filesdep −QuickCheckdep −checkersdep −tastydep ~lensdep ~metarPVP ok
version bump matches the API change (PVP)
Dependencies removed: QuickCheck, checkers, tasty, tasty-hunit, tasty-quickcheck
Dependency ranges changed: lens, metar
API changes (from Hackage documentation)
Files
- changelog.md +10/−0
- metar-http.cabal +5/−38
- src-exe/Main.hs +4/−6
- src/Data/Aviation/Metar/Http.hs +166/−131
- test/Tests.hs +0/−4
changelog.md view
@@ -1,3 +1,13 @@+0.0.5++* Update to metar-0.0.5 library+* Use `getMETAR` (BOM for `Y*` codes, NOAA fallback) instead of NOAA only+* Add hlint and fourmolu configuration+* Add `bin/lint.sh` and `bin/test.sh`+* Add doctests; remove empty test-suite+* Add `{-# OPTIONS_GHC -Wall #-}` to all source files+* Remove `NoImplicitPrelude`+ 0.0.4 * Update to GHC 9.6.7 compatibility
metar-http.cabal view
@@ -1,5 +1,5 @@ name: metar-http-version: 0.0.4+version: 0.0.5 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@sıɹɹoɯʇ>@@ -8,15 +8,15 @@ synopsis: HTTP for METAR category: Data, Aviation description: A trivial HTTP program for getting METAR-homepage: https://gitlab.com/tonymorris/metar-http-bug-reports: https://gitlab.com/tonymorris/metar-http/issues+homepage: https://github.com/tonymorris/metar-http+bug-reports: https://github.com/tonymorris/metar-http/issues cabal-version: >= 1.10 build-type: Simple extra-source-files: changelog.md source-repository head type: git- location: git@gitlab.com:tonymorris/metar-http.git+ location: git@github.com:tonymorris/metar-http.git library default-language:@@ -26,7 +26,7 @@ base >= 4.8 && < 5 , http-types >= 0.9 && < 1 , lens >= 4 && < 6- , metar >= 0.0.4 && < 1.0+ , metar >= 0.0.5 && < 1.0 , network-uri >= 2.6 && < 3 , text >= 1.2 && < 3 , semigroups >= 0.9 && < 1@@ -41,10 +41,6 @@ -Wall -threaded - default-extensions:-- NoImplicitPrelude- hs-source-dirs: src @@ -66,34 +62,5 @@ -Wall -threaded - default-extensions:- NoImplicitPrelude- hs-source-dirs: src-exe--test-suite tests-- build-depends: QuickCheck >=2.9.2- , base >=4.8 && < 5- , checkers >=0.4.6- , metar-http- , lens >=4- , tasty >=0.11- , tasty-hunit >=0.9- , tasty-quickcheck >=0.8.4-- type:- exitcode-stdio-1.0-- main-is:- Tests.hs-- hs-source-dirs:- test-- default-language:- Haskell2010-- ghc-options:- -Wall
src-exe/Main.hs view
@@ -1,14 +1,12 @@-{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Wall #-} -module Main(- main+module Main (+ main, ) where -import System.IO(IO)-import Data.Aviation.Metar.Http(metarHTTP)+import Data.Aviation.Metar.Http (metarHTTP) main :: IO () main = metarHTTP-
src/Data/Aviation/Metar/Http.hs view
@@ -1,52 +1,68 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wall #-} -module Data.Aviation.Metar.Http(- metarHTTP-, metarHTTPapp+-- | HTTP server exposing METAR observations. Australian aerodromes (ICAO codes+-- beginning with @Y@) are fetched from BOM; other codes fall back to NOAA.+module Data.Aviation.Metar.Http (+ metarHTTP,+ metarHTTPapp, ) where -import Control.Category((.), id)-import Control.Lens((^.), (^?), _Wrapped, folded)-import Data.Aviation.Metar(getNOAAMETAR)-import Data.Aviation.Metar.METARResult(_METARResultValue)-import Data.ByteString.Lazy.UTF8 hiding (take, splitAt)-import Data.Eq(Eq)-import Data.Functor((<$>))-import Data.Function(($))-import Data.Int(Int)-import Data.List(intercalate, take, splitAt)-import Data.Maybe(Maybe(Nothing, Just))-import Data.String(String)-import Data.Semigroup((<>))-import Data.Text(unpack, toLower)-import Data.Tuple(fst)-import Network.HTTP.Types.Header(hContentType)-import Network.HTTP.Types.Status(status404, status200)-import Network.Wai(Application, responseLBS, pathInfo)-import Network.Wai.Handler.Warp(setPort, setTimeout, runSettings, defaultSettings)-import System.Environment(getArgs)-import System.IO(IO)-import Text.Read(Read, reads)-import Text.Show(Show)+import Control.Lens (folded, (^.), (^?), _Wrapped)+import Data.Aviation.Metar (getMETAR)+import Data.Aviation.Metar.METARResult (_METARResultValue)+import Data.ByteString.Lazy.UTF8 (fromString)+import Data.List (intercalate)+import Data.Text (toLower, unpack)+import Network.HTTP.Types.Header (hContentType)+import Network.HTTP.Types.Status (status200, status404)+import Network.Wai (Application, pathInfo, responseLBS)+import Network.Wai.Handler.Warp (defaultSettings, runSettings, setPort, setTimeout)+import System.Environment (getArgs) +{- FOURMOLU_DISABLE -}+-- $setup+-- >>> import Data.Aviation.Metar.Http+{- FOURMOLU_ENABLE -}++-- | Parse a value using its 'Read' instance, returning 'Nothing' on failure.+--+-- >>> readMaybe "42" :: Maybe Int+-- Just 42+--+-- >>> readMaybe "notanumber" :: Maybe Int+-- Nothing readMaybe ::- Read a =>- String- -> Maybe a+ (Read a) =>+ String ->+ Maybe a readMaybe n = fst <$> reads n ^? folded -data CharLimit =- NoCharLimit+-- | How to truncate a rendered METAR line.+data CharLimit+ = NoCharLimit | MaxChars Int | MaxCharsAppend Int String deriving (Eq, Show) +-- | Apply a 'CharLimit' to a string.+--+-- >>> charLimit NoCharLimit "hello world"+-- "hello world"+--+-- >>> charLimit (MaxChars 5) "hello world"+-- "hello"+--+-- >>> charLimit (MaxCharsAppend 5 "...") "hello world"+-- "hello..."+--+-- >>> charLimit (MaxCharsAppend 5 "...") "hi"+-- "hi" charLimit ::- CharLimit- -> String- -> String+ CharLimit ->+ String ->+ String charLimit m s = case m of NoCharLimit ->@@ -54,58 +70,49 @@ MaxChars n -> take n s MaxCharsAppend n l ->- let (a, b) =- splitAt n s- b' =- case b of- [] ->- []- _:_ ->- l- in a <> b'+ let (a, b) = splitAt n s+ b' = case b of+ [] -> []+ _ : _ -> l+ in a <> b' -data Format =- Raw+-- | How to format a list of METAR lines for a response body.+data Format+ = Raw | MaxLines Int CharLimit | AllOneLine CharLimit deriving (Eq, Show) --- |+-- | Render lines of METAR text according to the given 'Format'. -- -- >>> format (MaxLines 3 NoCharLimit) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK\nRF00.0/000.4"--- +-- -- >>> format (MaxLines 1 NoCharLimit) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK"--- +-- -- >>> format (MaxLines 1 (MaxChars 15)) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 0712" -- -- >>> format (MaxLines 1 (MaxCharsAppend 15 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 0712abc"--- +-- -- >>> format (AllOneLine (MaxCharsAppend 15 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 0712abc"--- --- >>> format (AllOneLine (MaxCharsAppend 150 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"]--- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4" ----- >>> format (AllOneLine (MaxCharsAppend 120 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"]+-- >>> format (AllOneLine (MaxCharsAppend 150 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4" ----- >>> format (AllOneLine (MaxCharsAppend 80 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"]--- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK RF00.0/000.4"--- -- >>> format (AllOneLine (MaxCharsAppend 60 "abc")) ["METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK","RF00.0/000.4"] -- "METAR YBAF 071230Z AUTO 16006KT 9999 // NCD 24/20 Q1011 RMK abc" format ::- Format- -> [String]- -> String+ Format ->+ [String] ->+ String format f s = let limitCalate l x = charLimit l . intercalate x- in case f of+ in case f of Raw -> intercalate "\n" s MaxLines n l ->@@ -113,41 +120,69 @@ AllOneLine l -> limitCalate l " " s --- Raw--- * AllOneLine NoCharLimit--- */n AllOneLine (MaxChars n)--- */n/xyz AllOneLine (MaxCharsAppend n xyz)--- n MaxLines n NoCharLimit--- n/m MaxLines n (MaxChars m)--- n/m/xyz MaxLines n (MaxCharsAppend m xyz)+-- | Parse the trailing URI path components into a 'Format'.+--+-- URI grammar:+--+-- @+-- (empty) -> Raw+-- * -> AllOneLine NoCharLimit+-- *\/n -> AllOneLine (MaxChars n)+-- *\/n\/xyz -> AllOneLine (MaxCharsAppend n xyz)+-- n -> MaxLines n NoCharLimit+-- n\/m -> MaxLines n (MaxChars m)+-- n\/m\/xyz -> MaxLines n (MaxCharsAppend m xyz)+-- @+--+-- >>> uriPathFormat []+-- Raw+--+-- >>> uriPathFormat ["*"]+-- AllOneLine NoCharLimit+--+-- >>> uriPathFormat ["*", "80"]+-- AllOneLine (MaxChars 80)+--+-- >>> uriPathFormat ["*", "80", "..."]+-- AllOneLine (MaxCharsAppend 80 "...")+--+-- >>> uriPathFormat ["3"]+-- MaxLines 3 NoCharLimit+--+-- >>> uriPathFormat ["3", "40"]+-- MaxLines 3 (MaxChars 40)+--+-- >>> uriPathFormat ["3", "40", "..."]+-- MaxLines 3 (MaxCharsAppend 40 "...")+--+-- >>> uriPathFormat ["notanumber"]+-- Raw uriPathFormat ::- [String]- -> Format+ [String] ->+ Format uriPathFormat [] = Raw-uriPathFormat (q:r) =+uriPathFormat (q : r) = let rawMaybe ::- Read a =>- (a -> CharLimit)- -> String- -> CharLimit+ (Read a) =>+ (a -> CharLimit) ->+ String ->+ CharLimit rawMaybe f n =- case readMaybe n of- Nothing ->- NoCharLimit- Just c ->- f c- r' =- case r of- [] ->- NoCharLimit- s:ss ->- rawMaybe (\n -> case ss of- [] ->- MaxChars n- t:_ ->- MaxCharsAppend n t) s- in case q of+ maybe NoCharLimit f (readMaybe n)+ r' = case r of+ [] ->+ NoCharLimit+ s : ss ->+ rawMaybe+ ( \n -> case ss of+ [] ->+ MaxChars n+ t : _ ->+ MaxCharsAppend n t+ )+ s+ in case q of "*" -> AllOneLine r' _ ->@@ -157,6 +192,7 @@ Just l -> MaxLines l r' +-- | WAI 'Application' serving METAR observations. metarHTTPapp :: Application metarHTTPapp req withResp =@@ -165,54 +201,55 @@ a <> "\n" <> b a <//> b = a </> "\n" <> b- in "/metar/<icao>" </>- "raw metar for station <icao>" <//>- "/metar/<icao>/*" </>- "metar for station <icao> all on one line" <//>- "/metar/<icao>/*/<maxchars>" </>- "metar for station <icao> all on one line truncated at <maxchars>" <//>- "/metar/<icao>/*/<maxchars>/<appendstr>" </>- "metar for station <icao> all on one line truncated at <maxchars> and if truncation occurs, append <appendstr>" <//>- ""+ in "/metar/<icao>"+ </> "raw metar for station <icao>"+ <//> "/metar/<icao>/*"+ </> "metar for station <icao> all on one line"+ <//> "/metar/<icao>/*/<maxchars>"+ </> "metar for station <icao> all on one line truncated at <maxchars>"+ <//> "/metar/<icao>/*/<maxchars>/<appendstr>"+ </> "metar for station <icao> all on one line truncated at <maxchars> and if truncation occurs, append <appendstr>"+ <//> "" _404 = responseLBS status404 [] msg- in case pathInfo req of- (rpt:xxxx:r) ->+ in case pathInfo req of+ (rpt : xxxx : r) -> let xxxx' = unpack xxxx modifyOutput ::- [String]- -> String+ [String] ->+ String modifyOutput = format (uriPathFormat (unpack <$> r)) mt = case toLower rpt of "metar" ->- Just ("METAR", getNOAAMETAR xxxx')+ Just ("METAR", getMETAR xxxx') "taf" -> Nothing _ -> Nothing- in case mt of+ in case mt of Nothing -> withResp _404 Just (mtt, mtf) ->- do t <- mtf ^. _Wrapped- withResp $- case t ^? _METARResultValue of- Nothing ->- responseLBS- status404- []- ("no " <> mtt <> " found for " <> fromString xxxx')- Just x ->- responseLBS- status200- [(hContentType, "text/plain")]- (fromString (modifyOutput [x]))+ do+ t <- mtf ^. _Wrapped+ withResp $+ case t ^? _METARResultValue of+ Nothing ->+ responseLBS+ status404+ []+ ("no " <> mtt <> " found for " <> fromString xxxx')+ Just x ->+ responseLBS+ status200+ [(hContentType, "text/plain")]+ (fromString (modifyOutput [x])) [] -> withResp $ responseLBS@@ -222,18 +259,16 @@ _ -> withResp _404 +-- | Run 'metarHTTPapp' with Warp, optionally taking a port from the first+-- command-line argument. metarHTTP :: IO () metarHTTP =- do a <- getArgs- let p =- case a of- [] ->- id- (q:_) ->- case readMaybe q of- Nothing ->- id- Just n ->- setPort n- runSettings (setTimeout 6 (p defaultSettings)) metarHTTPapp+ do+ a <- getArgs+ let p = case a of+ [] ->+ id+ (q : _) ->+ maybe id setPort (readMaybe q)+ runSettings (setTimeout 6 (p defaultSettings)) metarHTTPapp
− test/Tests.hs
@@ -1,4 +0,0 @@-module Main where--main :: IO ()-main = pure ()