avwx (empty) → 0.1.0.0

raw patch · 9 files changed

+1075/−0 lines, 9 filesdep +HTTPdep +attoparsecdep +avwxsetup-changed

Dependencies added: HTTP, attoparsec, avwx, base, pretty-show, text

Files

• LICENSE +20/−0
• README.md +50/−0
• Setup.hs +2/−0
• app/Main.hs +21/−0
• avwx.cabal +48/−0
• changelog.md +3/−0
• src/Data/Aviation/WX.hs +878/−0
• src/Data/Aviation/WX/Fetcher.hs +21/−0
• test/Spec.hs +32/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014-2016, Hans-Christian Esperer <hc-av@hcesperer.org>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,50 @@+avwx+====++Fetch and parse aviation weather reports.++Currently, only standard METAR reports are supported, subject to extensive+testing. RMK sections are not yet supported. Making this parser work with all METARs is pretty tedious and difficult,+because every country seems to be using some subtly different specification.+This parser was written with the publicly available documentation from+DWD (Deutscher Wetterdienst) in mind, so it should work with all German+METARs. Patches (pull requests) and suggestions are very welcome!++Important: "For educational purposes only, *not* for flight planning! Use at+your own risk."++# Usage++This package is intended to be used as a library. However, for demonstration purposes,+it comes with a small command line utility that can be invoked like this:++    hc@hc-pc ~ λ metar eddf llbg eham tncm++The output will look like this:++    Fetching weather information for eddf+    Parsing "METAR EDDF 281650Z 15006KT 9999 FEW034 SCT048 BKN130 22/15 Q1015 NOSIG="+    METAR+      { date = Date 28 16 50+      , station = ICAO "EDDF"+      , flags = []+      , wind =+          Just+            Wind+              { direction = Degrees 150 , velocity = Knots 6 , gusts = Nothing }+      , visibility = [ TenOrMore ]+      , runwayvis = []+      , runwaycond = []+      , wx = []+      , clouds =+          [ Cloud FEW (Height 3400) Unclassified+          , Cloud SCT (Height 4800) Unclassified+          , Cloud BKN (Height 13000) Unclassified+          ]+      , pressure = Just (QNH 1015)+      , temperature = Just 22+      , dewPoint = Just 15+      , trend = NOSIG+      , remark = Nothing+          }+    ...

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,21 @@+module Main+    ( main+    ) where++import Control.Monad+import System.Environment+import Text.Show.Pretty++import Data.Aviation.WX.Fetcher++main :: IO ()+main = do+    stations <- getArgs+    forM_ stations $ \station -> do+        putStrLn $ "Fetching weather information for " ++ station+        wx <- fetchMetar station+        putStrLn $ case wx of+            Right weather ->+                ppShow weather+            Left error ->+                "No information available for " ++ station ++ ": " ++ show error

@@ -0,0 +1,48 @@+name:                avwx+version:             0.1.0.0+synopsis:            Parse METAR weather reports+description:         Parse METAR weather reports+homepage:            https://github.com/hce/avwx+license:             MIT+license-file:        LICENSE+author:              Hans-Christian Esperer <hc@hcesperer.org>+maintainer:          Hans-Christian Esperer <hc@hcesperer.org>+copyright:           2016, Hans-Christian Esperer+category:            Aviation+build-type:          Simple+extra-source-files:  README.md changelog.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Aviation.WX+                     , Data.Aviation.WX.Fetcher+  -- other-modules:       Data.Aviation.WX.Fetcher+  build-depends:       base >= 4.7 && < 5+                     , attoparsec+                     , HTTP+                     , text >= 1.2.2.1 && < 1.3+  default-language:    Haskell2010++executable metar+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -rtsopts+  build-depends:       base+                     , avwx+                     , pretty-show+  default-language:    Haskell2010++test-suite avwx-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , avwx+                     , text+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/VirtualForgeGmbH/hascar.git

@@ -0,0 +1,3 @@+# Jun 28 2016++First release.

@@ -0,0 +1,878 @@+{-# LANGUAGE OverloadedStrings #-}
+-- |
+-- Module: Data.Aviation.WX
+-- Copyright: (C) 2014-2016, Hans-Christian Esperer
+-- License: MIT
+-- Maintainer: Hans-Christian Esperer <hc@hcesperer.org>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Parse aviation weather reports. A qualified import is recommended.
+module Data.Aviation.WX
+    ( parseWeather
+    , weatherParser
+    , Weather(..)
+    , Date(..)
+    , Station(..)
+    , Flag(..)
+    , Wind(..)
+    , Visibility(..)
+    , Runway(..)
+    , VisTrend(..)
+    , RunwayCondition(..)
+    , WeatherPhenomenon(..)
+    , Cloud(..)
+    , Pressure(..)
+    , Trend(..)
+    , WPDesc(..)
+    , WPPrecipitation(..)
+    , WPObfuscation(..)
+    , WPOther(..)
+    , Distance(..)
+    , Direction(..)
+    , RwyCoverType(..)
+    , RunwayBraking(..)
+    , Vertical(..)
+    , WindDirection(..)
+    , Cover(..)
+    , CloudType(..)
+    , WPIntensity(..)
+    , Transition(..)
+    , Unit(..)
+    ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.Attoparsec.Text
+import Data.Maybe
+import Data.Text (Text, pack)
+
+-- | Aviation weather, currently only METARs are supported.
+data Weather
+    = -- | A METeorological Aerodrome Report
+      METAR
+    { -- | The observation date.
+      date        :: Date
+    , -- | The designation of the observing station.
+      station     :: Station
+    , -- | A remark about the reported observation.
+      flags       :: [Flag]
+    , -- | The observed wind.
+      wind        :: Maybe Wind
+    , -- | The observed visibility.
+      visibility  :: [Visibility]
+    , -- | The observed visibility for specific runways,
+      -- usually reported if the runway visibility significantly
+      -- differs from the general reported visibility.
+      runwayvis   :: [(Runway, [Visibility], Maybe VisTrend)]
+    , -- | Surface or close conditions of a specific runway.
+      runwaycond  :: [RunwayCondition]
+    , -- | Observed weather phenomena
+      wx          :: [WeatherPhenomenon]
+    , -- | Observed cloud layers
+      clouds      :: [Cloud]
+    , -- | Measured pressure
+      pressure    :: Maybe Pressure
+    , -- | Measured pressure
+      temperature :: Maybe Int
+    , -- | Determined dew point
+      dewPoint    :: Maybe Int
+    , -- | Expected changes within the next two hours
+      trend       :: Trend
+    , -- | RMK section (Additional parts of a METAR report that are not
+      -- part of the official METAR message but are commonly used
+      -- in various parts of the world; unparsed)
+      remark      :: Maybe Text }
+    | -- | An automatic terminal information service report
+      ATIS
+    | -- | A non-scheduled METAR
+      SPECI
+    | -- | A terminal aerodrome forecast
+      TAF
+    | -- | An aviation wx hazard message of moderate severity
+      AIRMET
+    | -- | A significant meteorological information message
+      SIGMET
+    | -- | A general aviation forecase message
+      GAMET
+    deriving (Eq, Show)
+
+-- | A flag describing an aviation meteorological report
+data Flag
+    = -- | A message has been corrected after the beginning of
+      -- its original validity period
+      COR
+    | -- | A message has been corrected prior to its
+      -- original validity period
+      AMD
+    | -- | A message has been generated fully automatic
+      -- without a plausibility check by a human
+      AUTO
+    deriving (Eq, Show)
+
+-- | The trend part of a METAR message specifies expected
+-- changes in weather conditions within the next two hours.
+-- A Trend/Transition part of a TAF message specified expected
+-- changes in weather conditions within the specified range.
+data Trend
+    = -- | A transition that will start within the defined
+      -- time frame and be completed at the end of the defined
+      -- time frame
+      BECMG [Transition]
+    | -- | A transition that will start within the defined
+      -- time frame and be finished at the end of the defined
+      -- time frame
+      TEMPO [Transition]
+    | -- | A probability specification.
+      -- As one of my FIs (ex-atc at EDDF) used to put it:
+      -- 30% means "I'm quite sure it won't happen but will still
+      -- put it in here, in case it does after all."
+      -- 40% means "I'm certain it will happen but will still
+      -- put it with 40%, in case it does not happen after all."
+      PROB Int Trend
+    | -- | NOSIG is only applicable to METARs. It means that
+      -- no significant changes are expected within the next
+      -- two hours.
+      NOSIG
+    | -- | NOTAVAIL is only applicable to METARs. It means that
+      -- the METAR message in question does not contain a TREND
+      -- section.
+      NOTAVAIL
+    deriving (Eq, Show)
+
+-- | A transition in weather conditions.
+-- A transition can either be temporary or permanent;
+-- this will be encoded in the container structure.
+data Transition
+    = -- | A change of wind strength or direction
+      TransWind Wind
+    | -- | A change of visibility
+      TransVis [Visibility]
+    | -- | A change of visibility for a specific runway
+      TransRunwayVis [(Runway, [Visibility], Maybe VisTrend)]
+    | -- | A change of weather phenomenon
+      TransWX [WeatherPhenomenon]
+    | -- | A change of ceiling or cloud layers
+      TransClouds [Cloud]
+    deriving (Eq, Show)
+
+-- | A visibility trend specifically for runway conditions
+data VisTrend
+    = -- | Visibility will improve (maybe do wait a bit)
+      VisTrendUpward
+    | -- | Visibility will deteriorate (still, don't rush
+      -- the take off and use proper phraseology at all times)
+      VisTrendDownward
+    | -- | No expected change in runway visibility conditions
+      VisTrendNoDistinctTendency
+    deriving (Eq, Show)
+
+-- | A pressure value. This is intentionally coded
+-- individually and not converted to a specific reference.
+data Pressure
+    = -- | The QNH value in hectopascals. QNH is the current
+      -- pressure at sea level, corrected for pressure and
+      -- temperature changes at the station level.
+      QNH Int
+    | -- | The same as QNH, only in inches
+      -- (Do you know the old joke?:
+      --   * ATC: Liner 1723 descend to 3,000ft, the QNH is 1013mb.
+      --   * Liner 1723: Uh, approach, can we have that in inches please?
+      --   * ATC: Liner 1723 descend to 36,000 inches, the QNH is 1013mb.
+      Altimeter Int
+    | -- | The current pressure at station level in hectopascals.
+      QFE Int
+    | -- | The current pressure at sea level in hectopascals.
+      QFF Int
+    deriving (Eq, Show)
+
+-- | A weather phenomenon.
+-- This can be an observed phenomenon in the case of METARs or an
+-- expected phenomenon in the case of TAFs.
+data WeatherPhenomenon
+    = Phenomenon
+    { -- | The intensity of the phenomenon.
+      intensity :: WPIntensity
+    , -- | The description of the weather phenomenon.
+      desc      :: Maybe WPDesc
+    , -- | The precipitation type of the weather phenomenon.
+      prec      :: Maybe WPPrecipitation
+    , -- | The effects of the phenomenon on the visibility
+      obfus     :: Maybe WPObfuscation
+    , -- | Other details about the phenomenon.
+      other     :: Maybe WPOther }
+    deriving (Eq, Show)
+
+-- | The intensity of an observed or expected weather phenomenon.
+data WPIntensity
+    = -- | Light
+      Light
+    | -- | Moderate
+      Moderate
+    | -- | Heavy
+      Heavy
+    | -- | Only applicable to METARs. The weather phenomenon was
+      -- observed in the vicinity of the observed area, not within
+      -- the observed area itself.
+      Vicinity
+    | -- | Only applicable to METARs. The weather phenomenon was
+      -- recently observed in the past, but was not observed at
+      -- the time the report was issued.
+      Recent
+    deriving (Enum, Eq, Show)
+
+-- | The description of a weather phenomenon.
+data WPDesc
+    = -- | Shallow.
+      Shallow
+    | -- | Patches.
+      Patches
+    | -- | Partial.
+      WXPartial
+    | -- | Low, drifting.
+      LowDrifting
+    | -- | Blowing.
+      Blowing
+    | -- | Shower.
+      Shower
+    | -- | Thunderstorm.
+      Thunderstorm
+    | -- | Freezing.
+      Freezing
+    deriving (Enum, Eq, Ord, Show)
+
+-- | The type of the precipitation
+data WPPrecipitation
+    = -- | Drizzle.
+      Drizzle
+    | -- | Rain.
+      Rain
+    | -- | Snow.
+      Snow
+    | -- | Snow grains.
+      ShowGrains
+    | -- | Ice crystals.
+      IceCrystals
+    | -- | Ice pellets.
+      IcePellets
+    | -- | Hail.
+      Hail
+    | -- | Snow pellets.
+      SnowPellets
+    | -- | Unknown type of precipitation.
+      UnknownPrecipitation
+    deriving (Enum, Eq, Ord, Show)
+
+-- | Effects on the visibility by a weather phenomenon
+data WPObfuscation
+    = -- | Mist. Visibility impaired but still greater than 1000m
+      Mist
+    | -- | Fog. Visibility less than 1000m.
+      Fog
+    | -- | Smoke.
+      Smoke
+    | -- | Volcanic ash.
+      VolcanicAsh
+    | -- | Dust.
+      Dust
+    | -- | Sand.
+      Sand
+    | -- | Haze.
+      Haze
+    deriving (Enum, Eq, Ord, Show)
+
+-- | Other important information about a weather phenomenon.
+data WPOther
+    = -- | Dust or sand whirls.
+      DustOrSandwhirls
+    | -- | Squalls.
+      Squalls
+    | -- | Tornado.
+      Tornado
+    | -- | Sand storm.
+      Sandstorm
+    | -- | Dust storm.
+      Duststorm
+    deriving (Enum, Eq, Ord, Show)
+
+-- | The Distance.
+data Distance
+    = -- | The distance in metres.
+      Metres Int
+    | -- | The distance in km.
+      KM Int
+    | -- | The distance in statute miles.
+      SM Int
+    | -- | The distance in nautical miles.
+      NM Int
+    deriving (Eq, Show)
+
+-- | Vertical visibility.
+data Visibility
+    = -- | Ten kilometres or more.
+      TenOrMore
+    | -- | Fifty metres or less.
+      FiftyMetresOrLess
+    | -- | Two kilometres or more.
+      TwoOrMore
+    | -- | A specific visibility.
+      Visibility Distance (Maybe Direction)
+    deriving (Eq, Show)
+
+-- | Directions.
+data Direction
+    = -- | North.
+      North
+    | -- | South.
+      South
+    | -- | East.
+      East
+    | -- | West.
+      West
+    | -- | Northwest.
+      NorthWest
+    | -- | Northeast.
+      NorthEast
+    | -- | Southwest.
+      SouthWest
+    | -- | Southeast.
+      SouthEast
+    | -- | Left runway for runways of the same QFU
+      -- (part of the runway designator)
+      RWYLeft
+    | -- | Right runway for runways of the same QFU
+      -- (part of the runway designator)
+      RWYRight
+    | -- | Centre runway for runways of the same QFU
+      -- (part of the runway designator)
+      RWYCenter
+    deriving (Eq, Show)
+
+-- | Runway specification.
+data Runway
+    = -- | All runways.
+      AllRunways
+    | -- | A specific runway.
+      Runway
+    { -- | The runway's magnetic orientation, divided by ten and rounded.
+      runwayQFU                 :: Int
+    , -- | For multiple runways with the same QFU, a left, right or centre
+      -- selector is added.
+      runwayDirection           :: Maybe Direction }
+    deriving (Eq, Show)
+
+-- | The runway contamination type.
+data RwyCoverType
+    = -- | The runway is not contaminated.
+      RCTDry
+    | -- | The runway is moist.
+      RCTMoist
+    | -- | The runway is wet.
+      RCTWet
+    | -- | The runway is convered with rime.
+      RCTRime
+    | -- | The runway is covered with dry snow.
+      RCTDrySnow
+    | -- | The runway is covered with wet snow.
+      RCTWetSnow
+    | -- | The runway is covered with slush.
+      RCTSlush
+    | -- | The runway is covered with ice.
+      RCTIce
+    | -- | The runway is covered with frozen ruts or ridges.
+      RCTFZRut
+    | -- | The runway contamination type is unknown.
+      RCTUnknown
+    deriving (Eq, Show, Enum)
+
+-- | Runway conditions.
+data RunwayCondition
+    = -- | Specific runway conditions exist.
+      RunwayCondition
+    { -- | The runway for which specific conditions
+      -- have been observed.
+      rwcondRunway :: Runway
+    , -- | Whether and how the runway is contamindated.
+      rwcondCover  :: RwyCoverType
+    , -- | The extent of the contamination in percent.
+      rwcondSpread :: Maybe Int
+    , -- | The height of the contamination in millimetres.
+      rwcondCoverHeight :: Maybe Int
+    , -- | The friction coefficient or braking action value.
+      rwcondBrkCoeff :: RunwayBraking }
+    | -- | The runway is closed.
+      RwyClosed
+    { -- | The runway that is closed.
+      rwclosedRunway :: Runway }
+    | -- | The whole aerodrome is closed.
+      ADClosed
+    deriving (Eq, Show)
+
+-- | The measured brake efficiency of a specific runway.
+data RunwayBraking
+    = -- | The friction coefficient.
+      BrakingFriction Int
+    | -- | The braking coefficient.
+      BrakingEffect Int
+    deriving (Eq, Show)
+
+-- | An obersvation date.
+data Date
+    = Date Int Int Int
+    deriving (Eq, Show)
+
+-- | An aeronautical weather station designator.
+data Station
+    = -- | The station as identified by its aerodrome's
+      -- ICAO code.
+      ICAO Text
+    deriving (Eq, Show)
+
+-- | A vertical position specification.
+data Vertical
+    = -- | A vertical position with reference to the ground
+      -- in feet.
+      Height Int
+    | -- | A vertical position with reference to the mean
+      -- sea level/QNH in feet.
+      Altitude Int
+    | -- | A pressure altitude with reference to the
+      -- standard QNH of 1013 hectopascals in hundrets of feet.
+      FlightLevel Int
+    | -- | Vertical position is not specified.
+      VertNotSpec
+    deriving (Eq, Show)
+
+-- | Wind information.
+data Wind
+    = Wind
+    { -- | The direction the wind is blowing from.
+      direction :: WindDirection
+    , -- | The wind speed.
+      velocity  :: Unit
+    , -- | The strength of the observed gusts, if any.
+      gusts     :: Maybe Int
+    } deriving (Eq, Show)
+
+-- | The direction the wind is blowing from.
+data WindDirection
+    = -- | The wind is blowing in equal or almost equal
+      -- strength from a wide variety of directions.
+      Variable
+    | -- | The wind is blowing from the specified direction.
+      -- Directions can be given with reference to true or
+      -- magnetic north, depending on the type of weather
+      -- observation/forecast message.
+      Degrees Int
+    | -- | The wind is blowing from a specific direction
+      -- range.
+      Varying
+    { -- | The mean direction the wind is blowing from.
+      mean :: Int
+    , -- | The minimum direction the wind is blowing from.
+      from :: Int
+    , -- | The maximum direction the wind is blowing from.
+      to   :: Int
+    } deriving (Eq, Show)
+     
+
+-- | A speed unit.
+data Unit
+    = -- | Nautical miles per hour
+      Knots Int
+    | -- | Statute miles per hour
+      Miles Int
+    | -- | Kilometres per hour
+      KMH Int
+    deriving (Eq, Show)
+
+-- | A cloud specification.
+data Cloud
+    = -- | No specific clouds could be observed, because
+      -- the (given) ground visibility was too low or because
+      -- the ground is covered in clouds.
+      VVis (Maybe Int)
+    | -- | Clouds were observed.
+      Cloud Cover Vertical CloudType
+    deriving (Eq, Show)
+
+-- | The type of cloud.
+data CloudType
+    = -- | A cumulonimbus cloud.
+      Cumulonimbus
+    | -- | A developing cb cloud.
+      ToweringCumulus
+    | -- | A stratus cloud.
+      Stratus
+    | -- | A cumulus cloud.
+      Cumulus
+    | -- | A stratocumulus cloud.
+      Stratocumulus
+    | -- | An altostratus cloud.
+      Altostratus
+    | -- | An altocumulus cloud.
+      Altocumulus
+    | -- | A cirrostratus cloud.
+      Cirrostratus
+    | -- | A cirrus cloud.
+      Cirrus
+    | -- | An unclassified cloud.
+      Unclassified
+    deriving (Enum, Eq, Show)
+
+-- | The area that is covered.
+data Cover
+    = -- | 1-2 eights are covered.
+      FEW
+    | -- | 3-4 eights are covered.
+      SCT
+    | -- | 5-7 eights are covered.
+      BKN
+    | -- | More than 7 eights are covered.
+      OVC
+    | -- | Cover not specified
+      CoverNotSpecified
+    deriving (Enum, Eq, Ord, Show)
+
+stationParser :: Parser Station
+stationParser = ICAO <$> Data.Attoparsec.Text.take 4
+
+dateParser :: Parser Date
+dateParser = Date <$> twin <*> twin <*> (twin <* "Z")
+    where twin = (\a b -> read [a, b]) <$> digit <*> digit
+
+variableWindParser :: WindDirection -> Parser WindDirection
+variableWindParser (Degrees meanWind) = try $ do
+    dir1 <- (\a b c -> read [a, b, c]) <$> digit <*> digit <*> digit
+    _ <- char 'V'
+    dir2 <- (\a b c -> read [a, b, c]) <$> digit <*> digit <*> digit
+    return $ Varying meanWind dir1 dir2
+variableWindParser _ = fail "Erroneous parameters"
+
+windParser :: Parser Wind
+windParser = do
+    dir <- choice [readwinddir, variablewind]
+    str <- readwindstr
+    gustsies <- option Nothing readgusts
+    unit <- readunit
+    dir2 <- option dir $ char ' ' >> variableWindParser dir
+    return $ Wind dir2 (unit str) gustsies
+    where
+        variablewind = "VRB" `means` Variable
+        readwinddir = (\a b c -> Degrees . read $ [a, b, c]) <$> digit <*> digit <*> digit
+        readwindstr = (\a b -> read [a, b]) <$> digit <*> digit
+        readunit = choice [ "KT" `means` Knots
+                          , "MPH" `means` Miles
+                          , "KM" `means` KMH]
+        readgusts = (\_ b c -> Just . read $ [b, c]) <$> char 'G' <*> digit <*> digit
+
+pressureParser :: Parser Pressure
+pressureParser = choice [qnh, mmhg]
+    where
+      qnh = (\_ a b c d -> QNH $ read [a, b, c, d]) <$> char 'Q' <*> digit <*> digit <*> digit <*> digit
+      mmhg = (\_ a b c d -> Altimeter $ read [a, b, c, d]) <$> char 'A' <*> digit <*> digit <*> digit <*> digit
+
+wxParser :: Parser WeatherPhenomenon
+wxParser = do
+    skipSpace
+    intsy <- intensityParser
+    dsc <- perhaps descParser
+    prc <- perhaps precipitationParser
+    obfs <- perhaps obfuscationParser
+    othr <- perhaps otherParser
+    when ( (== 0) . Prelude.length . Prelude.filter not $
+        [ isNothing dsc, isNothing prc
+        , isNothing obfs, isNothing othr ] ) $ fail ""
+    return $ Phenomenon intsy dsc prc obfs othr
+
+perhaps :: Parser a -> Parser (Maybe a)
+perhaps parser = option Nothing $ Just <$> parser
+
+perhaps_ :: Parser a -> Parser ()
+perhaps_ parser = void $ perhaps parser
+
+callsfor :: Text -> Parser a -> Parser a
+a `callsfor` b = string a >> b
+
+means :: Text -> a -> Parser a
+a `means` b = string a >> return b
+
+means' :: Text -> a -> Parser a
+a `means'` b = try $ skipSpace >> string a >> skipSpace >> return b
+
+descParser :: Parser WPDesc
+descParser = choice
+    [ "MI" `means` Shallow
+    , "BC" `means` Patches
+    , "PR" `means` WXPartial
+    , "DR" `means` LowDrifting
+    , "BL" `means` Blowing
+    , "SH" `means` Shower
+    , "TS" `means` Thunderstorm
+    , "FZ" `means` Freezing ]
+
+precipitationParser :: Parser WPPrecipitation
+precipitationParser = choice
+    [ "DZ" `means` Drizzle
+    , "RA" `means` Rain
+    , "SN" `means` Snow
+    , "SG" `means` ShowGrains
+    , "IC" `means` IceCrystals
+    , "PL" `means` IcePellets
+    , "GR" `means` Hail
+    , "GS" `means` SnowPellets
+    , "UP" `means` UnknownPrecipitation ]
+
+obfuscationParser :: Parser WPObfuscation
+obfuscationParser = choice
+    [ "BR" `means` Mist
+    , "FG" `means` Fog
+    , "FU" `means` Smoke
+    , "VA" `means` VolcanicAsh
+    , "DU" `means` Dust
+    , "SA" `means` Sand
+    , "HZ" `means` Haze ]
+
+otherParser :: Parser WPOther
+otherParser = choice
+    [ "PO" `means` DustOrSandwhirls
+    , "SQ" `means` Squalls
+    , "FC" `means` Tornado
+    , "SS" `means` Sandstorm
+    , "DS" `means` Duststorm ]
+
+intensityParser :: Parser WPIntensity
+intensityParser = option Moderate $ choice
+    [ char '-' >> return Light
+    , char '+' >> return Heavy
+    , "VC" `means` Vicinity
+    , "RE" `means` Recent ]
+
+visibilityParser :: Parser Visibility
+visibilityParser = skipSpace >> choice [ tenormore, arb, arb1, metres ]
+    where
+        tenormore = string "9999" >> return TenOrMore
+        metres = (\a b c d dir -> Visibility (visunit $ read [a,b,c,d]) dir) <$> digit <*> digit <*> digit <*> digit <*> directionParser
+        visunit :: Int -> Distance
+        visunit n = if n > 5000
+            then KM (n `quot` 1000)
+            else Metres n
+        arb  = (\a b unit -> Visibility (unit $ read [a,b])) <$> digit <*> digit <*> distanceUnitParser <*> directionParser
+        arb1 = (\a unit -> Visibility (unit $ read ['0', a])) <$> digit <*> distanceUnitParser <*> directionParser
+
+directionParser :: Parser (Maybe Direction)
+directionParser = Nothing `option` (Just <$> choice
+    [ "NE" `means` NorthEast, "NW" `means` NorthWest
+    , "SE" `means` SouthEast, "SW" `means` SouthWest
+    , "N" `means` North, "S" `means` South
+    , "E" `means` East, "W" `means` West ])
+
+distanceUnitParser :: Parser (Int -> Distance)
+distanceUnitParser = choice
+    [ "KM" `means` KM
+    , "SM" `means` SM
+    , "NM" `means` NM ]
+
+cloudParser :: Parser [Cloud]
+cloudParser = choice [(:[]) <$> vvisParser, nsc, cavok, clr, sepBy1' clds (char ' ')]
+    where
+        clds = do
+            perhaps_ space
+            intsy <- cloudIntensityParser
+            height <- choice
+                [ "///" `means` VertNotSpec
+                , (\a b c -> Height $ (* 100) $ read [a, b, c]) <$> digit <*> digit <*> digit ]
+
+            cloudType <- cloudTypeParser
+            return $ Cloud intsy height cloudType
+        cavok = skipSpace >> "CAVOK" `means` []
+        nsc = skipSpace >> "NSC" `means` []
+        clr = skipSpace >> "CLR" `means` []
+
+vvisParser :: Parser Cloud
+vvisParser = do
+    _ <- string "VV"
+    choice
+        [ "///" `means` VVis Nothing
+        , (\a b c -> VVis . Just . read $ [a,b,c]) <$> digit <*> digit <*> digit ]
+
+cloudIntensityParser :: Parser Cover
+cloudIntensityParser = choice
+    [ "FEW" `means` FEW
+    , "SCT" `means` SCT
+    , "BKN" `means` BKN
+    , "OVC" `means` OVC
+    , "///" `means` CoverNotSpecified ]
+
+cloudTypeParser :: Parser CloudType
+cloudTypeParser = option Unclassified $ choice
+    [ "CB" `means` Cumulonimbus
+    , "TCU" `means` ToweringCumulus
+    , "ST" `means` Stratus
+    , "CU" `means` Cumulus
+    , "SC" `means` Stratocumulus
+    , "AS" `means` Altostratus
+    , "AC" `means` Altocumulus
+    , "CS" `means` Cirrostratus
+    , "CI" `means` Cirrus
+    , "///" `means` Unclassified]
+
+perhapsMinus :: Parser String
+perhapsMinus = "" `option` (char 'M' >> return "-")
+
+tdParser :: Parser (Int, Int)
+tdParser = do
+    tmpr <- (\pm a b -> read (pm ++ [a, b]) :: Int) <$> perhapsMinus <*> digit <*> digit
+    _ <- char '/'
+    dewpoint <- (\pm a b -> read (pm ++ [a, b]) :: Int) <$> perhapsMinus <*> digit <*> digit
+    return (tmpr, dewpoint)
+
+flagsParser :: Parser [Flag]
+flagsParser = many' $ choice
+    [ "COR" `means'` COR
+    , "AMD" `means'` AMD
+    , "AUTO" `means'` AUTO ]
+
+runwayvisParser :: Parser (Runway, [Visibility], Maybe VisTrend)
+runwayvisParser = do
+    runway <- runwayDesignationParser
+    _ <- char '/'
+    vis <- parseRwyVis
+    vistrend <- Nothing `option` (Just <$> choice
+        [ "D" `means` VisTrendDownward
+        , "N" `means` VisTrendNoDistinctTendency
+        , "U" `means` VisTrendUpward ] )
+    return (runway, vis, vistrend)
+    where
+        parseRwyVis :: Parser [Visibility]
+        parseRwyVis = do
+            worstvis <- Nothing `option` (Just <$> choice visspec <* "V")
+            vis <- Just <$> choice visspec
+            return $ catMaybes [worstvis, vis]
+                        
+        visspec =
+            [ "M0050" `means` FiftyMetresOrLess
+            , "P2000" `means` TwoOrMore
+            , fourDigits >>= \a -> return $ Visibility (Metres a) Nothing
+            , trieDigits >>= \a -> return $ Visibility (Metres a) Nothing ]
+                        
+runwayconditionParser :: Parser RunwayCondition
+runwayconditionParser = do
+    runway <- runwayDesignationParser
+    _ <- char '/'
+    choice
+        [ "SNOCLO" `means` ADClosed
+        , rwycond runway ]
+
+    where
+        rwycond runway = do
+            cover <- RCTUnknown `option` ((toEnum . read . (:[])) <$> digit)
+            spread <- choice
+                [ char '/' >> return Nothing
+                , (Just . read . (:[])) <$> digit ]
+            spreadheight <- choice
+                [ string "//" >> return Nothing
+                , Just <$> tuhDigits ]
+            rkorbw <- tuhDigits
+            let coff = if rkorbw <= 90
+                    then BrakingFriction rkorbw
+                    else BrakingEffect rkorbw
+            return $ RunwayCondition runway cover spread spreadheight coff
+
+fourDigits :: Parser Int
+fourDigits = (\a b c d -> read [a,b,c,d]) <$> digit <*> digit <*> digit <*> digit
+
+trieDigits :: Parser Int
+trieDigits = (\a b c -> read [a,b,c]) <$> digit <*> digit <*> digit
+
+tuhDigits :: Parser Int
+tuhDigits = (\a b -> read [a,b]) <$> digit <*> digit
+
+runwayDesignationParser :: Parser Runway
+runwayDesignationParser = choice ["R88" `means` AllRunways, oneRunway]
+    where
+        oneRunway = do
+            _ <- char 'R'
+            magheading <- (\a b -> read [a,b]) <$> digit <*> digit :: Parser Int
+            dir <- Nothing `option` (Just <$> choice
+                [ "L" `means` RWYLeft
+                , "R" `means` RWYRight
+                , "C" `means` RWYCenter ])
+            return $ Runway magheading dir
+
+trendParser :: Parser Trend
+trendParser = choice
+    [ "NOSIG" `means` NOSIG
+    , changeParser ]
+    where
+        changeParser :: Parser Trend
+        changeParser = do
+            changes <- changesParser :: Parser [Trend]
+            when (length changes /= 1) $ fail "A METAR contains exactly one transition"
+            return $ head changes
+
+changesParser :: Parser [Trend]
+changesParser = many1 $ skipSpace >> transitionTypeParser
+    where
+        transitionTypeParser :: Parser Trend
+        transitionTypeParser = choice
+                [ "TEMPO" `callsfor` (TEMPO <$> transitionParser)
+                , "BECMG" `callsfor` (BECMG <$> transitionParser)
+                , "PROB" `callsfor`  (PROB  <$> twoDigits <*> (head <$> changesParser)) ]
+        transitionParser :: Parser [Transition]
+        transitionParser = sepBy1' oneTransition (char ' ')
+        oneTransition = do
+            skipSpace
+            choice . map try $
+              [ TransClouds    <$> cloudParser
+              , TransWind      <$> windParser
+              , TransVis       <$> many1' visibilityParser
+              , TransWX        <$> count 1 wxParser
+              , TransRunwayVis <$> sepBy' runwayvisParser (char ' ') ]
+
+twoDigits :: Parser Int
+twoDigits = (\a b -> read [a,b]) <$> digit <*> digit
+
+metarParser :: Parser Weather
+metarParser = do
+    _ <- string "METAR"
+    reportflags <- flagsParser
+    identifier <- skipSpace >> stationParser
+    reportdate <- skipSpace >> dateParser
+    reportflags2 <- flagsParser
+    reportwind <- Nothing `option` (skipSpace >> Just <$> windParser)
+    skipSpace
+    reportvis <- [TenOrMore] `option` many1 visibilityParser
+    skipSpace
+    reportrunwaycond <- sepBy' runwayconditionParser (char ' ')
+    reportrunwayvis <- sepBy' runwayvisParser (char ' ')
+    reportwx <- many' wxParser
+    reportclouds <- [] `option` (skipSpace >> cloudParser)
+    (reporttemp, reportdewpoint) <- (Nothing, Nothing) `option` (skipSpace >> tdParser >>= \(w,d) -> return (Just w, Just d))
+    reportpressure <- Nothing `option` (skipSpace >> Just <$> pressureParser)
+    void $ many' $ skipSpace >> pressureParser -- Sometimes, multiple pressure values are offered
+    skipSpace
+    reporttrend <- NOTAVAIL `option` trendParser
+    reportrmk <- maybeRMK
+    skipSpace
+    _ <- choice $ map char "=$"
+    return $ METAR reportdate identifier (reportflags ++ reportflags2)
+        reportwind reportvis reportrunwayvis reportrunwaycond reportwx
+        reportclouds reportpressure reporttemp reportdewpoint
+        reporttrend reportrmk
+
+maybeRMK :: Parser (Maybe Text)
+maybeRMK = Nothing `option` do
+    void $ choice [ string "RMK ", string " RMK " ]
+    Just . pack <$> many1 (satisfy (notInClass "$="))
+
+-- | An attoparsec parser that can parse METAR messages.
+weatherParser :: Parser Weather
+weatherParser = metarParser
+
+maybeOneSpace :: Parser ()
+maybeOneSpace = perhaps_ space
+
+-- | Parse the given METAR text.
+parseWeather :: Text -> Either String Weather
+parseWeather = parseOnly weatherParser

@@ -0,0 +1,21 @@+module Data.Aviation.WX.Fetcher where++import Data.Char+import Data.List (filter)+import Data.Text (pack)+import Network.HTTP++import Data.Aviation.WX++type ICAOStationDesignator = String++fetchMetar :: ICAOStationDesignator -> IO (Either String Weather)+fetchMetar icao = do+    let icao' = map toUpper . filter isAlpha $ icao+    metarString <- simpleHTTP (getRequest $ url icao') >>= getResponseBody+    let wx = pack $ "METAR " ++ relLine metarString ++ "="+    putStrLn $ "Parsing " ++ show wx+    return $ parseWeather wx+    where+        url designator = "http://weather.noaa.gov/pub/data/observations/metar/stations/" ++ designator ++ ".TXT"+        relLine s = Prelude.lines s !! 1

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module Main+    ( main+    ) where++import Control.Monad+import Data.Text++import Data.Aviation.WX++frankfurt   :: Text+frankfurt   = "METAR EDDF 010203Z 14032KT 130V240 9999 FEW017 SCT023CB BKN042 42/23 Q1029 NOSIG="++juliana     :: Text+juliana     = "METAR TNCM 281400Z 13009KT 9999 SCT018 29/24 Q1018 A3007 NOSIG="++loxt        :: Text+loxt        = "METAR LOXT 281350Z 25007KT 220V290 50KM FEW040CU SCT120AC BKN300CI 27/12 Q1017 NOSIG RMK BKN="++main :: IO ()+main = do+    let Right frankfurt' = parseWeather frankfurt+    unless (temperature frankfurt' == Just 42) $ error "Temperature Frankfurt should be 42 degrees"+    unless (dewPoint frankfurt' == Just 23) $ error "Dew point Frankfurt should be 23 degrees"++    let Right juliana' = parseWeather juliana+    unless (temperature juliana' == Just 29) $ error "It's 29 degrees in St. Maarten!"+    unless (dewPoint juliana' == Just 24) $ error "What's with the dew point in St. Maarten?"++    let Right loxt' = parseWeather loxt+    unless (temperature loxt' == Just 27) $ error "Temperature LOXT should be 27 degrees centigrade!"+    unless (dewPoint loxt' == Just 12) $ error "Dew point LOXT should be 12 degrees centigrade!"