packages feed

metar (empty) → 0.0.1

raw patch · 10 files changed

+577/−0 lines, 10 filesdep +HTTPdep +QuickCheckdep +basesetup-changed

Dependencies added: HTTP, QuickCheck, base, checkers, deriving-compat, lens, metar, network-uri, semigroupoids, semigroups, tagsoup, tagsoup-selection, tasty, tasty-hunit, tasty-quickcheck, transformers

Files

+ LICENCE view
@@ -0,0 +1,31 @@+Copyright 2017,2018 Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++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.cabal view
@@ -0,0 +1,100 @@+name:               metar+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:           Australian METAR+category:           Data, Aviation+description:       +  Obtain Australian METAR from Bureau of Meteorology (BOM).+  .+  If that fails, get the METAR from NOAA.+homepage:           https://github.com/tonymorris/metar+bug-reports:        https://github.com/tonymorris/metar/issues+cabal-version:      >= 1.10+build-type:         Simple+extra-source-files: changelog.md++source-repository   head+  type:             git+  location:         git@github.com:tonymorris/metar.git++library+  default-language:+                    Haskell2010++  build-depends:+                    base >= 4.8 && < 5+                    , HTTP >= 4000 && < 5000+                    , lens >= 4 && < 5+                    , network-uri >= 2.6 && < 3+                    , semigroups >= 0.9 && < 0.19+                    , semigroupoids >= 5.2 && < 6+                    , tagsoup >= 0.13 && < 0.15+                    , tagsoup-selection >= 0.1 && < 0.2+                    , transformers >= 0.5 && < 0.6+                    , deriving-compat+                    +  ghc-options:+                    -Wall++  default-extensions:+  +                    NoImplicitPrelude++  hs-source-dirs:+                    src++  exposed-modules:+                    Data.Aviation.Metar+                    , Data.Aviation.Metar.BOMTAFResult+                    , Data.Aviation.Metar.TAFResult+                    , Data.Aviation.Metar.TAFResultT++executable          metar+  main-is:+                    Main.hs++  default-language:+                    Haskell2010++  build-depends:+                    base >= 4.8 && < 5+                    , metar++  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+                    , 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,15 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Main(+  main+) where++import Data.Aviation.Metar(runMETAR)+import System.Environment(getArgs)+import System.IO(IO)++main ::+  IO ()+main =+  do  a <- getArgs+      runMETAR a
+ src/Data/Aviation/Metar.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Aviation.Metar(+  getBOMTAF+, getNOAAMETAR+, getAllMETAR+, getAllTAF+, runMETAR+) where++import Control.Applicative(pure)+import Control.Category((.))+import Control.Lens(view, _Wrapped)+import Control.Monad(Monad((>>=)))+import Data.Aviation.Metar.BOMTAFResult(BOMTAFResponse(BOMTAFResponse), bomMETAR, bomTAF)+import Data.Aviation.Metar.TAFResult(TAFResult(ConnErrorResult, ParseErrorResult, TAFResultValue))+import Data.Aviation.Metar.TAFResultT(TAFResultT(TAFResultT))+import Data.Char(toUpper)+import Data.Either(Either(Left, Right))+import Data.Foldable(length)+import Data.Functor(fmap)+import Data.List(intercalate)+import Data.Maybe(Maybe(Nothing, Just))+import Data.String(String, lines)+import Data.Semigroup((<>))+import Network.HTTP(Request, Response, setHeaders, setRequestBody, mkRequest, RequestMethod(POST, GET), Header(Header), HeaderName(..), rspBody, simpleHTTP)+import Network.Stream(ConnError)+import Network.URI(URI(URI), URIAuth(URIAuth))+import Prelude(show)+import System.IO(IO, hPutStrLn, putStrLn, stderr)+import Text.HTML.TagSoup(Tag(TagText))+import Text.HTML.TagSoup.Tree(TagTree(TagBranch, TagLeaf), parseTree)++withResult ::+  (r -> Maybe a) ->+  Either ConnError r ->+  TAFResult a+withResult _ (Left e) =+  ConnErrorResult e+withResult k (Right s) =+  case k s of+    Nothing ->+      ParseErrorResult+    Just z ->+      TAFResultValue z++getBOMTAF ::+  String+  -> TAFResultT IO BOMTAFResponse+getBOMTAF =+  let mkTAFResponse ::+        [TagTree String]+        -> Maybe BOMTAFResponse+      mkTAFResponse (TagBranch "h3" [] [TagLeaf (TagText title)] : TagBranch "p" [("class","product")] tafs : TagBranch "p" [("class","product")] metars:_) =+        let tagTexts q =+              q >>= \r ->+                case r of+                  TagLeaf (TagText v) ->+                    [v]+                  _ ->+                    []+        in  Just (BOMTAFResponse title (tagTexts tafs) (tagTexts metars))+      mkTAFResponse _ =+        Nothing+      request ::+        String+        -> Request String+      request yxxx =+        let reqBody =+              "keyword=" <> yxxx <> "&type=search&page=TAF"+        in  setHeaders+              (+                setRequestBody+                  (+                    mkRequest+                      POST+                      (URI "http" (Just (URIAuth "" "www.bom.gov.au" "")) "/aviation/php/process.php" "" "")+                  )+                  ("application/x-www-form-urlencoded", reqBody)+              )+              [+                Header HdrHost                        "www.bom.gov.au"+              , Header HdrUserAgent                   "tonymorris/metar"+              , Header HdrAccept                      "*/*"+              , Header HdrAcceptLanguage              "en-US,en;q=0.5"+              , Header HdrAcceptEncoding              "text/html"+              , Header HdrReferer                     "http://www.bom.gov.au/aviation/forecasts/taf/"+              , Header HdrConnection                  "keep-alive"+              , Header HdrContentType                 "application/x-www-form-urlencoded"+              , Header HdrContentLength               (show (length reqBody))+              , Header HdrCookie                      "check=ok; bom_meteye_windspeed_units_knots=yes"+              , Header HdrPragma                      "no-cache"+              , Header HdrCacheControl                "no-cache"+              , Header (HdrCustom "DNT")              "1"+              , Header (HdrCustom "X-Requested-With") "XMLHttpRequest"+              ]+      respTAF ::+        Response String+        -> Maybe BOMTAFResponse+      respTAF =+        mkTAFResponse . parseTree . rspBody+  in  TAFResultT . fmap (withResult respTAF) . simpleHTTP . request++-- http://tgftp.nws.noaa.gov/data/observations/metar/stations/xxxx.TXT+getNOAAMETAR ::+  String+  -> TAFResultT IO String+getNOAAMETAR =+  let request ::+        String+        -> Request String+      request xxxx =+        setHeaders+          (+            mkRequest+              GET+              (URI "http" (Just (URIAuth "" "tgftp.nws.noaa.gov" "")) ("data/observations/metar/stations/" <> fmap toUpper xxxx <> ".TXT") "" "")               +          )+          [+            Header HdrHost                        "tgftp.nws.noaa.gov"+          , Header HdrUserAgent                   "tonymorris/metar"+          , Header HdrAccept                      "*/*"+          , Header HdrAcceptLanguage              "en-US,en;q=0.5"+          , Header HdrAcceptEncoding              "text/html"+          , Header HdrConnection                  "keep-alive"+          , Header HdrPragma                      "no-cache"+          , Header HdrCacheControl                "no-cache"+          , Header (HdrCustom "DNT")              "1"+          ]+      respMETAR ::+        Response String+        -> Maybe String+      respMETAR r =+        case lines (rspBody r) of+          [_, r'] -> Just r'+          _ -> Nothing+  in TAFResultT . fmap (withResult respMETAR) . simpleHTTP . request++getAllMETAR ::+  String+  -> TAFResultT IO [String]+getAllMETAR x = +  fmap (view bomMETAR) (getBOMTAF x) <>+  fmap pure (getNOAAMETAR x)++getAllTAF ::+  String+  -> TAFResultT IO [String]+getAllTAF x = +  fmap (view bomTAF) (getBOMTAF x)++runMETAR ::+  [String]+  -> IO ()+runMETAR x =+  let stderr' =+        hPutStrLn stderr+  in  case x of+        [] ->+          stderr' "enter an argument (ICAO code)"+        (r:_) ->+          let s = view _Wrapped (fmap (intercalate "\n") (getAllMETAR r))+          in  s >>= \s' ->+              case s' of+                TAFResultValue a ->+                  putStrLn a+                ParseErrorResult ->+                  stderr' ("No METAR for " <> r)+                ConnErrorResult e ->+                  stderr' ("Network connection error " <> show e)
+ src/Data/Aviation/Metar/BOMTAFResult.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Aviation.Metar.BOMTAFResult where++import Control.Lens(makeClassy)+import Data.Eq(Eq)+import Data.Ord(Ord)+import Data.String(String)+import Prelude(Show)++data BOMTAFResponse =+  BOMTAFResponse {+    _bomTitle ::+      String+  , _bomTAF ::+      [String]+  , _bomMETAR ::+      [String]+  } deriving (Eq, Ord, Show)++makeClassy ''BOMTAFResponse
+ src/Data/Aviation/Metar/TAFResult.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Aviation.Metar.TAFResult where++import Control.Applicative(Applicative(pure, (<*>)))+import Control.Lens(makeClassy, makeClassyPrisms)+import Control.Monad(Monad(return, (>>=)))+import Data.Eq(Eq)+import Data.Eq.Deriving(deriveEq1)+import Data.Foldable(Foldable(foldr))+import Data.Functor(Functor(fmap), (<$>))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Extend(Extend(duplicated))+import Data.Semigroup(Semigroup((<>)))+import Data.Traversable(Traversable(traverse))+import Network.Stream(ConnError)+import Prelude(Show)+import Text.Show.Deriving(deriveShow1)++data TAFResult a =+  ConnErrorResult ConnError+  | ParseErrorResult+  | TAFResultValue a+  deriving (Eq, Show)++makeClassy ''TAFResult+makeClassyPrisms ''TAFResult+deriveEq1 ''TAFResult+deriveShow1 ''TAFResult++instance Functor TAFResult where+  fmap _ (ConnErrorResult e) =+    ConnErrorResult e+  fmap _ ParseErrorResult =+    ParseErrorResult+  fmap f (TAFResultValue a) =+    TAFResultValue (f a)++instance Apply TAFResult where+  ConnErrorResult e <.> _ =+    ConnErrorResult e+  ParseErrorResult <.> _ =+    ParseErrorResult+  TAFResultValue f <.> TAFResultValue a =+    TAFResultValue (f a)+  TAFResultValue _ <.> ConnErrorResult e =+    ConnErrorResult e+  TAFResultValue _ <.> ParseErrorResult =+    ParseErrorResult++instance Applicative TAFResult where+  pure =+    TAFResultValue+  (<*>) =+    (<.>)++instance Bind TAFResult where+  ConnErrorResult e >>- _ =+    ConnErrorResult e+  ParseErrorResult >>- _ =+    ParseErrorResult+  TAFResultValue a >>- f =+    f a++instance Monad TAFResult where+  return =+    pure+  (>>=) =+    (>>-)++instance Foldable TAFResult where+  foldr f z (TAFResultValue a) =+    f a z+  foldr _ z (ConnErrorResult _ ) =+    z+  foldr _ z ParseErrorResult =+    z++instance Traversable TAFResult where+  traverse f (TAFResultValue a) =+    TAFResultValue <$> f a+  traverse _ (ConnErrorResult e) =+    pure (ConnErrorResult e)+  traverse _ ParseErrorResult =+    pure ParseErrorResult++instance Alt TAFResult where+  TAFResultValue a <!> _ =+    TAFResultValue a+  ConnErrorResult _ <!> x =+    x+  ParseErrorResult <!> x =+    x++instance Extend TAFResult where+  duplicated (TAFResultValue a) =+    TAFResultValue (TAFResultValue a)+  duplicated (ConnErrorResult e) =+    ConnErrorResult e+  duplicated ParseErrorResult =+    ParseErrorResult++instance Semigroup (TAFResult a) where+  (<>) =+    (<!>)
+ src/Data/Aviation/Metar/TAFResultT.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Aviation.Metar.TAFResultT where++import Control.Applicative(Applicative(pure, (<*>)))+import Control.Category((.))+import Control.Monad(Monad(return, (>>=)), ap)+import Data.Aviation.Metar.TAFResult(TAFResult(TAFResultValue, ConnErrorResult, ParseErrorResult))+import Data.Eq(Eq((==)))+import Data.Foldable(Foldable(foldr))+import Data.Functor(Functor(fmap), (<$>))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Bind(Bind((>>-)))+import Data.Functor.Classes(Eq1, Show1, eq1, showsPrec1)+import Data.Functor.Extend(Extend(duplicated))+import Data.Ord((>))+import Data.Semigroup(Semigroup((<>)))+import Control.Lens hiding ((<.>))+import Control.Monad.IO.Class(MonadIO(liftIO))+import Control.Monad.Trans.Class(MonadTrans(lift))+import Data.Eq.Deriving(deriveEq1)+import Prelude(Show(showsPrec), showParen, showString)+import Text.Show.Deriving(deriveShow1)++newtype TAFResultT f a =+  TAFResultT+    (f (TAFResult a))++makeClassy ''TAFResultT+makeWrapped ''TAFResultT++instance (Eq a, Eq1 f) => Eq (TAFResultT f a) where+  TAFResultT x == TAFResultT y =+    eq1 x y++instance (Show a, Show1 f) => Show (TAFResultT f a) where+  showsPrec n (TAFResultT x) =+    showParen (n > 10) (showString "TafResultT " . showsPrec1 n x)++deriveEq1 ''TAFResultT+deriveShow1 ''TAFResultT++instance Functor f => Functor (TAFResultT f) where+  fmap f (TAFResultT x) =+    TAFResultT (fmap (fmap f) x)++instance Monad f => Apply (TAFResultT f) where+  (<.>) =+    ap++instance Monad f => Applicative (TAFResultT f) where+  pure =+    TAFResultT . pure . pure+  (<*>) =+    ap++instance Monad f => Bind (TAFResultT f) where+  (>>-) =+    (>>=)++instance Monad f => Monad (TAFResultT f) where+  return =+    pure+  TAFResultT x >>= f =+    TAFResultT+      (+        x >>= \x' ->+        case x' of+          TAFResultValue x'' ->+            let TAFResultT r = f x''+            in  r+          ConnErrorResult e ->+            pure (ConnErrorResult e)+          ParseErrorResult ->+            pure ParseErrorResult+      )++instance Foldable f => Foldable (TAFResultT f) where+  foldr f z (TAFResultT x) =+    foldr (\a b -> foldr f b a) z x++instance Traversable f => Traversable (TAFResultT f) where+  traverse f (TAFResultT x) =+    TAFResultT <$> traverse (traverse f) x++instance Monad f => Alt (TAFResultT f) where+  TAFResultT x <!> TAFResultT y =+    TAFResultT+      (+        x >>= \x' ->+        case x' of+          TAFResultValue x'' ->+            pure (TAFResultValue x'')+          ConnErrorResult _ ->+            y+          ParseErrorResult ->+            y+      )++instance Extend f => Extend (TAFResultT f) where+  duplicated (TAFResultT x) =+    TAFResultT (fmap (TAFResultValue . TAFResultT) (duplicated x))++instance MonadIO f => MonadIO (TAFResultT f) where+  liftIO =+    TAFResultT . liftIO . fmap pure++instance MonadTrans TAFResultT where+  lift =+    TAFResultT . fmap pure++instance Monad f => Semigroup (TAFResultT f a) where+  (<>) =+    (<!>)
+ test/Tests.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = pure ()