-- | -- Module: Main -- Copyright: (C) 2015 Braden Walters -- License: MIT (see LICENSE file) -- Maintainer: Braden Walters -- Stability: experimental -- Portability: ghc module Main where 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 -- |Data structure containing all program options. data ProgramOptions = ProgramOptions { poOrigin :: Location , poDestination :: Maybe Location , poOriginCity :: City , poDestinationCity :: City , poTime :: Maybe LocalTime , poTimeType :: Maybe TimeType , poOffset :: Integer , poLimit :: Integer } -- |Program options parser. programOptionsParser :: LocalTime -> Parser ProgramOptions programOptionsParser currentTime = ProgramOptions <$> (Location <$> strOption (long "origin" <> help "Location in the city from which to travel.")) <*> (strToMaybeLocation <$> strOption (long "destination" <> value "" <> help ("Location in the city to which to travel. Omit to " ++ "monitor the origin stop."))) <*> (City <$> strOption (long "origin-city" <> value (show defaultCity) <> help "City from which to travel.")) <*> (City <$> strOption (long "destination-city" <> value (show defaultCity) <> help "City to which to travel.")) <*> (strToTime currentTime <$> strOption (long "time" <> value "now" <> help "Time of departure of arrival.")) <*> (strToTimeType <$> strOption (long "time-type" <> value (show DepartureTime) <> 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 strToTime _ strTime = parseTime defaultTimeLocale "%d/%m/%Y %H:%M" strTime -- |Given a time type ("dep" or "arr"), return a TimeType if possible. strToTimeType :: String -> Maybe TimeType strToTimeType "dep" = Just DepartureTime strToTimeType "arr" = Just ArrivalTime strToTimeType _ = Nothing -- |Information about the program options parser. programOptionsInfo :: LocalTime -> ParserInfo ProgramOptions programOptionsInfo currentTime = info (programOptionsParser currentTime) fullDesc -- |Main program function. main :: IO () main = do timezone <- getCurrentTimeZone currentTime <- utcToLocalTime timezone <$> getCurrentTime execParser (programOptionsInfo currentTime) >>= optMain -- |Main program function after options parsing. optMain :: ProgramOptions -> IO () optMain opts = case programOptionsToRequest opts of 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 or monitor request from program options. programOptionsToRequest :: ProgramOptions -> Maybe (Either RouteRequest MonitorRequest) programOptionsToRequest opts = case (poTime opts, poTimeType opts) of (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. prettyRoute :: Route -> String prettyRoute route' = concat $ map prettyTrip $ routeTrips route' where prettyTrip trip = let l1 = "===== Strecke: ==============================================" l2 = " Dauer: " ++ tripDuration trip rest = concat $ map prettyLeg $ tripLegs trip in l1 ++ "\n" ++ l2 ++ "\n" ++ rest prettyLeg leg = let l1 = " * Teilstrecke (Linie: " ++ legNumber leg ++ "): " ++ legDesc leg rest = concat $ map prettyStop $ legStops leg in l1 ++ "\n" ++ rest prettyStop stop = let platform = if null $ stopPlatformName stop then "" else " (Gleis: " ++ stopPlatformName stop ++ ")" arrival = case stopArrival stop of Just arr -> " (Ankunft am " ++ formatTime defaultTimeLocale "%d.%m.%Y" (stopArrivalTime arr) ++ " um " ++ formatTime defaultTimeLocale "%H:%M" (stopArrivalTime arr) ++ " mit [" ++ show (stopArrivalDelayMins arr) ++ " Minuten] Verspätung)" Nothing -> "" departure = case stopDeparture stop of Just dep -> " (Abfahrt am " ++ formatTime defaultTimeLocale "%d.%m.%Y" (stopDepartureTime dep) ++ " um " ++ formatTime defaultTimeLocale "%H:%M" (stopDepartureTime dep) ++ " mit [" ++ show (stopDepartureDelayMins dep) ++ " Minuten] Verspätung)" Nothing -> "" 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"