dresdner-verkehrsbetriebe 0.1.1 → 1.0.0

raw patch · 5 files changed

+199/−27 lines, 5 filesdep +textdep ~HTTPdep ~aesondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: text

Dependency ranges changed: HTTP, aeson, base, time

API changes (from Hackage documentation)

Files

• dresdner-verkehrsbetriebe.cabal +14/−9
• src/Main.hs +61/−17
• src/Network/Transportation/Germany/DVB/Monitor.hs +87/−0
• src/Network/Transportation/Germany/DVB/Monitor/JSON.hs +36/−0
• src/Network/Transportation/Germany/DVB/Route.hs +1/−1

@@ -1,5 +1,5 @@ name: dresdner-verkehrsbetriebe-version: 0.1.1+version: 1.0.0 synopsis: Library and program for querying DVB (Dresdner Verkehrsbetriebe AG) license: MIT license-file: LICENSE@@ -8,19 +8,23 @@ category: Network build-type: Simple cabal-version: >= 1.10+Tested-With: GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1  library   exposed-modules:       Network.Transportation.Germany.DVB     , Network.Transportation.Germany.DVB.Route+    , Network.Transportation.Germany.DVB.Monitor   other-modules:       Network.Transportation.Germany.DVB.Route.JSON+    , Network.Transportation.Germany.DVB.Monitor.JSON   build-depends:-      base >= 4.7 && < 4.8-    , HTTP >= 4000.2 && < 4000.3+      base >= 4 && < 5+    , HTTP >= 4000.2 && < 4000.4     , old-locale >= 1.0.0 && < 1.0.1-    , time >= 1.4 && < 1.5-    , aeson >= 0.10.0 && < 0.11.0+    , time >= 1.5 && < 1.7+    , aeson >= 0.10.0 && < 1.0.0+    , text >= 1.1.1.0     , vector >= 0.11.0 && < 0.12.0     , bytestring >= 0.10.0 && < 0.11.0     , unordered-containers >= 0.2.0 && < 0.3.0@@ -30,11 +34,12 @@ executable dresdner-verkehrsbetriebe   main-is: Main.hs   build-depends:-      base >= 4.7 && < 4.8-    , HTTP >= 4000.2 && < 4000.3+      base >= 4 && < 5+    , HTTP >= 4000.2 && < 4000.4     , old-locale >= 1.0.0 && < 1.0.1-    , time >= 1.4 && < 1.5-    , aeson >= 0.10.0 && < 0.11.0+    , time >= 1.5 && < 1.7+    , aeson >= 0.10.0 && < 1.0.0+    , text >= 1.1.1.0     , vector >= 0.11.0 && < 0.12.0     , bytestring >= 0.10.0 && < 0.11.0     , unordered-containers >= 0.2.0 && < 0.3.0

@@ -8,23 +8,24 @@  module Main where -import Control.Applicative import Data.Time.Clock import Data.Time.Format import Data.Time.LocalTime import Network.Transportation.Germany.DVB import Network.Transportation.Germany.DVB.Route+import Network.Transportation.Germany.DVB.Monitor import Options.Applicative-import System.Locale  -- |Data structure containing all program options. data ProgramOptions = ProgramOptions   { poOrigin :: Location-  , poDestination :: Location+  , poDestination :: Maybe Location   , poOriginCity :: City   , poDestinationCity :: City   , poTime :: Maybe LocalTime   , poTimeType :: Maybe TimeType+  , poOffset :: Integer+  , poLimit :: Integer   }  -- |Program options parser.@@ -34,9 +35,11 @@     (Location <$>      strOption (long "origin" <>                 help "Location in the city from which to travel.")) <*>-    (Location <$>+    (strToMaybeLocation <$>      strOption (long "destination" <>-                help "Location in the city to which to travel.")) <*>+                value "" <>+                help ("Location in the city to which to travel. Omit to " +++                      "monitor the origin stop."))) <*>     (City <$>      strOption (long "origin-city" <>                 value (show defaultCity) <>@@ -52,8 +55,21 @@     (strToTimeType <$>      strOption (long "time-type" <>                 value (show DepartureTime) <>-                help "Departure (dep) or arrival (arr) time."))+                help "Departure (dep) or arrival (arr) time.")) <*>+    (read <$>+     strOption (long "offset" <>+                value "0" <>+                help "Offset of entries when monitoring the origin stop.")) <*>+    (read <$>+     strOption (long "limit" <>+                value "10" <>+                help "Limit of entries when monitoring the origin stop."))   where+    -- |Given a string that either contains text or is blank, return either a+    -- location or nothing respectively.+    strToMaybeLocation :: String -> Maybe Location+    strToMaybeLocation "" = Nothing+    strToMaybeLocation str = Just $ Location str     -- |Given the current time and a time string, return a time if possible.     strToTime :: LocalTime -> String -> Maybe LocalTime     strToTime now "now" = Just now@@ -80,25 +96,41 @@ optMain :: ProgramOptions -> IO () optMain opts =   case programOptionsToRequest opts of-    Just request -> do+    Just (Left request) -> do       result <- route request       case result of         Left err -> error ("The result is invalid: " ++ show err)         Right route' -> putStrLn $ prettyRoute route'+    Just (Right request) -> do+      result <- monitor request+      case result of+        Left err -> error ("The result is invalid: " ++ show err)+        Right connections -> putStrLn $ prettyMonitor connections     Nothing -> error "There are problems with the request." --- |Generate a route request from program options.-programOptionsToRequest :: ProgramOptions -> Maybe RouteRequest+-- |Generate a route or monitor request from program options.+programOptionsToRequest :: ProgramOptions ->+                           Maybe (Either RouteRequest MonitorRequest) programOptionsToRequest opts =   case (poTime opts, poTimeType opts) of-    (Just time, Just timeType) -> Just $ RouteRequest {-        routeReqOrigin = poOrigin opts,-        routeReqDestination = poDestination opts,-        routeReqCityOrigin = poOriginCity opts,-        routeReqCityDestination = poDestinationCity opts,-        routeReqTime = time,-        routeReqTimeType = timeType-      }+    (Just time, Just timeType) ->+      case poDestination opts of+        Just destination ->+          return $ Left $ RouteRequest {+            routeReqOrigin = poOrigin opts,+            routeReqDestination = destination,+            routeReqCityOrigin = poOriginCity opts,+            routeReqCityDestination = poDestinationCity opts,+            routeReqTime = time,+            routeReqTimeType = timeType+          }+        Nothing ->+          return $ Right $ MonitorRequest {+            monitorReqCity = poOriginCity opts,+            monitorReqStop = poOrigin opts,+            monitorReqOffset = poOffset opts,+            monitorReqLimit = poLimit opts+          }     (_, _) -> Nothing  -- |Print a route to be displayed to the user.@@ -139,3 +171,15 @@           l1 = "   ~ Haltestelle: " ++ stopName stop ++ platform ++ arrival ++                departure ++ "\n"       in l1++-- |Print transit connections to be displayed to the user.+prettyMonitor :: [TransitConnection] -> String+prettyMonitor connections = concat $ map prettyConnection connections+  where+    prettyConnection connection =+      let l1 = "===== Verbindung: ==========================================="+          l2 = " " ++ transConnDesc connection +++               " (Linie: " ++ transConnNumber connection ++ ")"+          l3 = " Kommt in: " ++ show (transConnArrivalMinutes connection) +++               " Minuten"+      in l1 ++ "\n" ++ l2 ++ "\n" ++ l3 ++ "\n"

@@ -0,0 +1,87 @@+-- |+-- Module: Network.Transportation.Germany.DVB.Monitor+-- Copyright: (C) 2016 Braden Walters+-- License: MIT (see LICENSE file)+-- Maintainer: Braden Walters <vc@braden-walters.info>+-- Stability: experimental+-- Portability: ghc++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++-- |All data sent to DVB to monitor a stop.+data MonitorRequest = MonitorRequest+  { monitorReqCity :: City+  , monitorReqStop :: Location+  , monitorReqOffset :: Integer+  , monitorReqLimit :: Integer+  } deriving (Show)++-- |Either monitor data or an error.+type MonitorResult = Either Error [TransitConnection]++-- |An arriving vehicle at the stop.+data TransitConnection = TransitConnection+  { transConnNumber :: String+  , transConnDesc :: String+  , transConnArrivalMinutes :: Integer+  } deriving (Show)++-- |All possible errors which could occur while fetching data, including HTTP+-- errors and JSON parsing errors.+data Error = HttpResetError | HttpClosedError | HttpParseError String |+             HttpMiscError String | JsonParseError String deriving (Show)++-- |Given information about a stop, query and return data from DVB about+-- vehicles stopping there.+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)++-- |The HTTP URL to query for DVB monitor data.+monitorUrl :: String+monitorUrl = "http://widgets.vvo-online.de/abfahrtsmonitor/Abfahrten.do"++-- |Take an HTTP connection error and convert it into an error which can be+-- returned in a RouteResult.+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,+      -- TODO: Use a total function instead of read.+      transConnArrivalMinutes = read $ JSON.transConnArrivalMinutes transConn+    }

@@ -0,0 +1,36 @@+-- |+-- Module: Network.Transportation.Germany.DVB.Monitor.JSON+-- Copyright: (C) 2016 Braden Walters+-- License: MIT (see LICENSE file)+-- Maintainer: Braden Walters <vc@braden-walters.info>+-- Stability: experimental+-- Portability: ghc++{-# LANGUAGE OverloadedStrings #-}++module Network.Transportation.Germany.DVB.Monitor.JSON+( TransitConnection(..)+) where++import Data.Aeson+import Control.Monad+import qualified Data.Text as T+import qualified Data.Vector as V++-- |An arriving vehicle at the stop.+data TransitConnection = TransitConnection+  { transConnNumber :: String+  , transConnDesc :: String+  , transConnArrivalMinutes :: String+  } deriving (Show)++instance FromJSON TransitConnection where+  parseJSON (Array arr) =+    if V.length arr == 3 then+      case (arr V.! 0, arr V.! 1, arr V.! 2) of+        (String number, String desc, String arrivalMinutes) ->+          return $ TransitConnection (T.unpack number) (T.unpack desc)+                                     (T.unpack arrivalMinutes)+        _ -> mzero+    else mzero+  parseJSON _ = mzero

@@ -29,7 +29,7 @@ import Network.Stream import Network.Transportation.Germany.DVB import qualified Network.Transportation.Germany.DVB.Route.JSON as JSON-import System.Locale+import System.Locale hiding (defaultTimeLocale)  -- |All data sent to DVB to query routes. data RouteRequest = RouteRequest