    -- | Look up METAR weather records.
    --
    -- Copyright (c) 2014 Bertram Felgenhauer <int-e@gmx.de>
    -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

    module Lambdabot.Plugin.Reference.Metar (metarPlugin) where

    import Lambdabot.Plugin
    import Lambdabot.Util.Browser (browseLB)

    import Network.Browser (request)
    import Network.HTTP (getRequest, rspCode, rspBody)
    import Data.Char (isAlpha, toUpper)

    metarPlugin :: Module ()
    metarPlugin :: Module ()
    metarPlugin = Module ()
    forall st. Module st
    newModule
        { moduleCmds = return
            [ (command "metar")
                { help = say "metar <ICAO airport code>\n\
                             \Look up METAR weather data for given airport."
                , process = doMetar
                }
            ]
        }

    addsUri :: String
    addsUri :: String
    addsUri =
        String
    "http://www.aviationweather.gov/adds/dataserver_current/httpparam"

    addsSrc :: String -> String
    addsSrc :: String -> String
    addsSrc String
    code = String
    addsUri String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
        String
    "?dataSource=metars&requestType=retrieve&format=csv&hoursBeforeNow=2\
        \&mostRecentForEachStation=true&stationString=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    code

    doMetar :: MonadLB m => String -> Cmd m ()
    doMetar :: forall (m :: * -> *). MonadLB m => String -> Cmd m ()
    doMetar String
    code | String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    code Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    4 Bool -> Bool -> Bool
    && (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isAlpha String
    code = do
        msg <- BrowserAction (HandleStream String) String -> Cmd m String
    forall (m :: * -> *) conn a.
    MonadLB m =>
    BrowserAction conn a -> m a
    browseLB (BrowserAction (HandleStream String) String -> Cmd m String)
    -> BrowserAction (HandleStream String) String -> Cmd m String
    forall a b. (a -> b) -> a -> b
    $ do
            let src :: String
    src = String -> String
    addsSrc ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper String
    code)
            (uri, resp) <- Request String
    -> BrowserAction (HandleStream String) (URI, Response String)
    forall ty.
    HStream ty =>
    Request ty -> BrowserAction (HandleStream ty) (URI, Response ty)
    request (Request String
     -> BrowserAction (HandleStream String) (URI, Response String))
    -> Request String
    -> BrowserAction (HandleStream String) (URI, Response String)
    forall a b. (a -> b) -> a -> b
    $ String -> Request String
    getRequest String
    src
            case rspCode resp of
                (Int
    2,Int
    _,Int
    _) -> String -> BrowserAction (HandleStream String) String
    forall a. a -> BrowserAction (HandleStream String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> BrowserAction (HandleStream String) String)
    -> String -> BrowserAction (HandleStream String) String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    extractMetar (Response String -> String
    forall a. Response a -> a
    rspBody Response String
    resp)
                ResponseCode
    _ -> String -> BrowserAction (HandleStream String) String
    forall a. a -> BrowserAction (HandleStream String) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> BrowserAction (HandleStream String) String)
    -> String -> BrowserAction (HandleStream String) String
    forall a b. (a -> b) -> a -> b
    $ String
    "Request failed."
        say msg
    doMetar String
    _ = () -> Cmd m ()
    forall a. a -> Cmd m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    extractMetar :: String -> String
    extractMetar :: String -> String
    extractMetar String
    body = case String -> [String]
    lines String
    body of
        ls :: [String]
    ls@(String
    "No errors" : [String]
    _) -> case (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ',') ([String] -> String
    forall a. HasCallStack => [a] -> a
    last [String]
    ls) of
            String
    "raw_text" -> String
    "No result."
            String
    l          -> String
    l
        [String]
    _ -> String
    "Request failed."