metar-http (empty) → 0.0.1
raw patch · 7 files changed
+256/−0 lines, 7 filesdep +QuickCheckdep +basedep +checkerssetup-changed
Dependencies added: QuickCheck, base, checkers, http-types, lens, metar, metar-http, network-uri, semigroupoids, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, transformers, utf8-string, wai, warp
Files
- LICENCE +30/−0
- Setup.hs +2/−0
- changelog.md +3/−0
- metar-http.cabal +97/−0
- src-exe/Main.hs +14/−0
- src/Data/Aviation/Metar/Http.hs +106/−0
- test/Tests.hs +4/−0
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright 2018 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
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.1++* Initial release
+ metar-http.cabal view
@@ -0,0 +1,97 @@+name: metar-http+version: 0.0.1+license: BSD3+license-file: LICENCE+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@sıɹɹoɯʇ>+maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@sıɹɹoɯʇ>+copyright: Copyright (c) 2018, Tony Morris+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+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++library+ default-language:+ Haskell2010++ build-depends:+ base >= 4.8 && < 5+ , http-types >= 0.9 && < 1+ , lens >= 4 && < 5+ , metar >= 0.0.1 && < 1.0+ , network-uri >= 2.6 && < 3+ , text >= 1.2 && < 1.3+ , semigroups >= 0.9 && < 0.19+ , semigroupoids >= 5.2 && < 6+ , transformers >= 0.5 && < 0.6+ , utf8-string >= 1.0 && < 2+ , warp >= 3.2 && < 3.3+ , wai >= 3.2 && < 3.3++ + ghc-options:+ -Wall++ default-extensions:+ + NoImplicitPrelude++ hs-source-dirs:+ src++ exposed-modules:+ Data.Aviation.Metar.Http++executable metar-http+ main-is:+ Main.hs++ default-language:+ Haskell2010++ build-depends:+ base >= 4.8 && < 5+ , metar-http++ ghc-options:+ -Wall++ default-extensions:+ NoImplicitPrelude++ hs-source-dirs:+ src-exe++test-suite tests++ build-depends: QuickCheck >=2.9.2 && <2.13+ , base >=4.8 && < 5+ , checkers >=0.4.6 && <0.5+ , metar-http+ , lens >=4 && <4.18+ , tasty >=0.11 && <1.2+ , tasty-hunit >=0.9 && <0.11+ , tasty-quickcheck >=0.8.4 && <0.11++ type: + exitcode-stdio-1.0++ main-is: + Tests.hs++ hs-source-dirs: + test++ default-language: + Haskell2010++ ghc-options: + -Wall
+ src-exe/Main.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Main(+ main+) where++import System.IO(IO)+import Data.Aviation.Metar.Http(metarHTTP)++main ::+ IO ()+main =+ metarHTTP+
+ src/Data/Aviation/Metar/Http.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Aviation.Metar.Http(+ metarHTTP+, metarHTTPapp+) where++import Control.Category((.), id)+import Control.Lens((^.), (^?), _Wrapped)+import Data.Aviation.Metar(getAllMETAR, getAllTAF)+import Data.Aviation.Metar.TAFResult(_TAFResultValue)+import Data.ByteString.Lazy.UTF8 hiding (take)+import Data.Functor((<$>))+import Data.Function(($))+import Data.List(intercalate, take)+import Data.Maybe(Maybe(Nothing, Just), listToMaybe)+import Text.Read(reads)+import Data.Semigroup((<>))+import Text.Show(show)+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, runSettings, defaultSettings)+import System.Environment(getArgs)+import System.IO(IO)++metarHTTPapp ::+ Application+metarHTTPapp req withResp =+ let msg =+ "path /metar/<icao> or /metar/<icao>/<nlines> or /taf/<icao> or /taf/<icao>/<nlines>"+ _404 =+ responseLBS+ status404+ []+ msg+ in case pathInfo req of+ (rpt:xxxx:r) ->+ let xxxx' =+ unpack xxxx+ tk r' =+ case unpack <$> r' of+ n:_ ->+ take . fst <$> listToMaybe (reads n)+ [] ->+ Just id+ mt =+ case toLower rpt of+ "metar" ->+ Just ("METAR", getAllMETAR xxxx')+ "taf" ->+ Just ("TAF", getAllTAF xxxx')+ _ ->+ Nothing+ in case mt of+ Nothing ->+ withResp _404+ Just (mtt, mtf) ->+ case tk r of+ Nothing ->+ withResp $+ responseLBS+ status404+ []+ ("not a valid number " <> fromString (show r))+ Just q ->+ do t <- (intercalate "\n" . q <$> mtf) ^. _Wrapped+ withResp $+ case t ^? _TAFResultValue of+ Nothing ->+ responseLBS+ status404+ []+ ("no " <> mtt <> " found for " <> fromString xxxx')+ Just x ->+ responseLBS+ status200+ [(hContentType, "text/plain")]+ (fromString x)+ [] ->+ withResp $+ responseLBS+ status200+ [(hContentType, "text/plain")]+ msg+ _ ->+ withResp _404++metarHTTP ::+ IO ()+metarHTTP =+ do a <- getArgs+ let p =+ case a of+ [] ->+ id+ (q:_) ->+ case fst <$> listToMaybe (reads q) of+ Nothing ->+ id+ Just n ->+ setPort n+ runSettings (p defaultSettings) metarHTTPapp
+ test/Tests.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = pure ()