-- | 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 :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = [Command (ModuleT () LB)]
-> ModuleT () LB [Command (ModuleT () LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"metar")
            { help :: Cmd (ModuleT () LB) ()
help = String -> Cmd (ModuleT () LB) ()
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 = String -> Cmd (ModuleT () LB) ()
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 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 :: String -> Cmd m ()
doMetar String
code | String -> 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
    String
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
uri, Response String
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 Response String -> ResponseCode
forall a. Response a -> ResponseCode
rspCode Response String
resp of
            (Int
2,Int
_,Int
_) -> String -> BrowserAction (HandleStream String) String
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 (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."
    String -> Cmd m ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
msg
doMetar String
_ = () -> Cmd m ()
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. [a] -> a
last [String]
ls) of
        String
"raw_text" -> String
"No result."
        String
l          -> String
l
    [String]
_ -> String
"Request failed."