module Network.Transportation.Germany.DVB.Monitor
( MonitorRequest(..)
, MonitorResult(..)
, TransitConnection(..)
, Error(..)
, monitor
) where
import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as BS8
import Network.HTTP
import Network.Stream
import Network.Transportation.Germany.DVB
import qualified Network.Transportation.Germany.DVB.Monitor.JSON as JSON
data MonitorRequest = MonitorRequest
{ monitorReqCity :: City
, monitorReqStop :: Location
, monitorReqOffset :: Integer
, monitorReqLimit :: Integer
} deriving (Show)
type MonitorResult = Either Error [TransitConnection]
data TransitConnection = TransitConnection
{ transConnNumber :: String
, transConnDesc :: String
, transConnArrivalMinutes :: Integer
} deriving (Show)
data Error = HttpResetError | HttpClosedError | HttpParseError String |
HttpMiscError String | JsonParseError String deriving (Show)
monitor :: MonitorRequest -> IO MonitorResult
monitor req = do
let (City city) = monitorReqCity req
(Location stop) = monitorReqStop req
params = [("ort", city),
("hst", stop),
("vz", show $ monitorReqOffset req),
("lim", show $ monitorReqLimit req)]
result <- simpleHTTP (getRequest (monitorUrl ++ "?" ++ urlEncodeVars params))
case result of
Left connError -> return $ Left $ connErrToResultErr connError
Right response' ->
let body = BS8.pack $ rspBody response'
in case eitherDecode body of
Left err ->
return $ Left $ JsonParseError err
Right transConns ->
return $ Right (map fromJsonTransitConnection transConns)
monitorUrl :: String
monitorUrl = "http://widgets.vvo-online.de/abfahrtsmonitor/Abfahrten.do"
connErrToResultErr :: ConnError -> Error
connErrToResultErr ErrorReset = HttpResetError
connErrToResultErr ErrorClosed = HttpClosedError
connErrToResultErr (ErrorParse msg) = HttpParseError msg
connErrToResultErr (ErrorMisc msg) = HttpMiscError msg
fromJsonTransitConnection :: JSON.TransitConnection -> TransitConnection
fromJsonTransitConnection transConn =
TransitConnection {
transConnNumber = JSON.transConnNumber transConn,
transConnDesc = JSON.transConnDesc transConn,
transConnArrivalMinutes = read $ JSON.transConnArrivalMinutes transConn
}