-- | 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 = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"metar")
            { help :: Cmd (ModuleT () LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"metar <ICAO airport code>\n\
                         \Look up METAR weather data for given airport."
            , process :: String -> Cmd (ModuleT () LB) ()
process = forall (m :: * -> *). MonadLB m => String -> Cmd m ()
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 forall a. [a] -> [a] -> [a]
++
    String
"?dataSource=metars&requestType=retrieve&format=csv&hoursBeforeNow=2\
    \&mostRecentForEachStation=true&stationString=" forall a. [a] -> [a] -> [a]
++ String
code

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