diff --git a/Data/GTFS/Parse.hs b/Data/GTFS/Parse.hs new file mode 100644 --- /dev/null +++ b/Data/GTFS/Parse.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE + ScopedTypeVariables + , ViewPatterns + , PatternGuards + , TemplateHaskell #-} + +{-# OPTIONS_GHC + -fno-warn-orphans #-} + +-- | Parsing GTFS files. +-- +-- Besides these functions, this module provides many orphan +-- instances of @'Field'@ and @'ParseRow'@. + +module Data.GTFS.Parse + ( parseFile + , parseFeed + ) where + +import Data.GTFS.Types + +import Text.RowRecord +import Text.RowRecord.TH + +import Data.List.Split +import Control.Applicative +import System.Directory +import System.IO.Unsafe ( unsafeInterleaveIO ) + +import qualified Text.CSV as CSV +import qualified System.FilePath as Path + +enumDecode :: forall a. (Enum a, Bounded a) => Maybe String -> Result a +enumDecode xs = decode xs >>= conv where + mx = fromEnum (maxBound :: a) + conv n + | n > mx = Failure $ NoParse "" ("out of range: " ++ show n) + | otherwise = Success $ toEnum n + +instance Field LocationType where decode = enumDecode +instance Field RouteType where decode = enumDecode +instance Field DirectionID where decode = enumDecode +instance Field OnOffType where decode = enumDecode +instance Field ServiceFlag where decode = enumDecode +instance Field ExceptionType where decode = enumDecode +instance Field PaymentMethod where decode = enumDecode +instance Field TransferType where decode = enumDecode + +instance Field Date where + decode = require f where + f (splitAt 4 -> (ys, splitAt 2 -> (ms, ds))) + | length ds == 2 + , Just [y,m,d] <- mapM safeRead [ys,ms,ds] + = Just $ Date y m d + f _ = Nothing + +instance Field Time where + decode = require f where + f (mapM safeRead . splitOn ":" -> Just [h,m,s]) + = Just $ Time h m s + f _ = Nothing + +$(rowRecords [ + ''Agency + , ''Stop + , ''Route + , ''Trip + , ''StopTime + , ''Calendar + , ''CalendarDate + , ''FareAttribute + , ''FareRule + , ''Shape + , ''Frequency + , ''Transfer ]) + +-- drop some bad rows from a CSV file +cleanup :: [[String]] -> [[String]] +cleanup = filter ok where + ok [] = False + ok [""] = False + ok _ = True + +getCSV :: FilePath -> IO [[String]] +getCSV p = do + x <- CSV.parseCSVFromFile p + case x of + Left e -> error ("CSV parse failed on " ++ p ++ ": " ++ show e) + Right v -> return . cleanup $ v + +-- | Parse a single GTFS data file. +-- +-- Since some files are optional, this produces an empty list +-- if the file does not exist. +parseFile :: (ParseRow a) => FilePath -> IO [a] +parseFile p = do + ex <- doesFileExist p + if not ex then return [] else go + where + go = do + x <- getCSV p + case fromStrings x >>= parseTable of + Failure e -> error ("field parse failure: " ++ show e) + Success y -> return y + +-- | Parse an entire feed directory. +-- +-- Each individual file is read and parsed only when its field in @'Feed'@ +-- is forced. The usual caveats of lazy I\/O apply. Parsing within a file +-- is not lazy. +-- +-- Alternatives to this function include @'parseFile'@ and @'parseRow'@. +parseFeed :: FilePath -> IO Feed +parseFeed d = + Feed <$> f "agency.txt" <*> f "stops.txt" <*> f "routes.txt" + <*> f "trips.txt" <*> f "stop_times.txt" <*> f "calendar.txt" + <*> f "calendar_dates.txt" <*> f "fare_attributes.txt" <*> f "fare_rules.txt" + <*> f "shapes.txt" <*> f "frequencies.txt" <*> f "transfers.txt" + where + f :: (ParseRow a) => String -> IO [a] + f x = unsafeInterleaveIO . parseFile $ Path.combine d x diff --git a/Data/GTFS/Types.hs b/Data/GTFS/Types.hs new file mode 100644 --- /dev/null +++ b/Data/GTFS/Types.hs @@ -0,0 +1,237 @@ +-- | Types in a GTFS feed. + +module Data.GTFS.Types + -- export everything + where + + +-- * Enums + +data LocationType + = LocStop + | LocStation + deriving (Show, Enum, Bounded, Eq, Ord) + +data RouteType + = Tram + | Metro + | Rail + | Bus + | Ferry + | CableCar + | Gondola + | Funicular + deriving (Show, Enum, Bounded, Eq, Ord) + +data DirectionID + = DirectionA + | DirectionB + deriving (Show, Enum, Bounded, Eq, Ord) + +data OnOffType + = RegularlyScheduled + | NotAvailable + | MustPhone + | MustAskDriver + deriving (Show, Enum, Bounded, Eq, Ord) + +data ServiceFlag + = NoService + | HasService + deriving (Show, Enum, Bounded, Eq, Ord) + +data ExceptionType + = NoException + | ServiceAdded + | ServiceRemoved + deriving (Show, Enum, Bounded, Eq, Ord) + +data PaymentMethod + = PayOnBoard + | PayBeforeBoarding + deriving (Show, Enum, Bounded, Eq, Ord) + +data TransferType + = RecommendedTransfer + | TimedTransfer + | MinimumTransfer + | NoTransfer + deriving (Show, Enum, Bounded, Eq, Ord) + + +-- * Row types + +data Agency = Agency + { a_agency_id :: Maybe AgencyID + , a_agency_name :: String + , a_agency_url :: URL + , a_agency_timezone :: Timezone + , a_agency_lang :: Maybe Language + , a_agency_phone :: Maybe Phone + } deriving (Show) + +data Stop = Stop + { s_stop_id :: StopID + , s_stop_code :: Maybe String + , s_stop_name :: String + , s_stop_desc :: Maybe String + , s_stop_lat :: LatLon + , s_stop_lon :: LatLon + , s_zone_id :: Maybe ZoneID + , s_stop_url :: Maybe URL + , s_location_type :: Maybe LocationType + , s_parent_station :: Maybe StopID + } deriving (Show) + +data Route = Route + { r_route_id :: RouteID + , r_agency_id :: Maybe AgencyID + , r_route_short_name :: String + , r_route_long_name :: String + , r_route_desc :: Maybe String + , r_route_type :: RouteType + , r_route_url :: Maybe URL + , r_route_color :: Maybe Color + , r_route_text_color :: Maybe Color + } deriving (Show) + +data Trip = Trip + { t_route_id :: RouteID + , t_service_id :: ServiceID + , t_trip_id :: TripID + , t_trip_headsign :: Maybe String + , t_trip_short_name :: Maybe String + , t_direction_id :: Maybe DirectionID + , t_block_id :: Maybe BlockID + , t_shape_id :: Maybe ShapeID + } deriving (Show) + +data StopTime = StopTime + { st_trip_id :: TripID + , st_arrival_time :: Time + , st_departure_time :: Time + , st_stop_id :: StopID + , st_stop_sequence :: Sequence + , st_stop_headsign :: Maybe String + , st_pickup_type :: Maybe OnOffType + , st_drop_off_type :: Maybe OnOffType + , st_shape_dist_traveled :: Maybe Distance + } deriving (Show) + +data Calendar = Calendar + { c_service_id :: ServiceID + , c_monday :: ServiceFlag + , c_tuesday :: ServiceFlag + , c_wednesday :: ServiceFlag + , c_thursday :: ServiceFlag + , c_friday :: ServiceFlag + , c_saturday :: ServiceFlag + , c_sunday :: ServiceFlag + , c_start_date :: Date + , c_end_date :: Date + } deriving (Show) + +data CalendarDate = CalendarDate + { cd_service_id :: ServiceID + , cd_date :: Date + , cd_exception_type :: ExceptionType + } deriving (Show) + +data FareAttribute = FareAttribute + { fa_fare_id :: FareID + , fa_price :: Price + , fa_currency_type :: Currency + , fa_payment_method :: PaymentMethod + , fa_transfers :: TransferLimit + , fa_transfer_duration :: Maybe Seconds + } deriving (Show) + +data FareRule = FareRule + { fr_fare_id :: FareID + , fr_route_id :: Maybe RouteID + , fr_origin_id :: Maybe ZoneID + , fr_destination_id :: Maybe ZoneID + , fr_contains_id :: Maybe ZoneID + } deriving (Show) + +data Shape = Shape + { sh_shape_id :: ShapeID + , sh_shape_pt_lat :: LatLon + , sh_shape_pt_lon :: LatLon + , sh_shape_pt_sequence :: Sequence + , sh_shape_dist_traveled :: Maybe Distance + } deriving (Show) + +data Frequency = Frequency + { fq_trip_id :: TripID + , fq_start_time :: Time + , fq_end_time :: Time + , fq_headway_secs :: Seconds + } deriving (Show) + +data Transfer = Transfer + { x_from_stop_id :: StopID + , x_to_stop_id :: StopID + , x_transfer_type :: TransferType + , x_min_transfer_time :: Maybe Seconds + } deriving (Show) + + +-- * The feed itself + +data Feed = Feed + { f_agency :: [Agency] + , f_stops :: [Stop] + , f_routes :: [Route] + , f_trips :: [Trip] + , f_stop_times :: [StopTime] + , f_calendar :: [Calendar] + , f_calendar_dates :: [CalendarDate] + , f_fare_attributes :: [FareAttribute] + , f_fare_rules :: [FareRule] + , f_shapes :: [Shape] + , f_frequencies :: [Frequency] + , f_transfers :: [Transfer] + } deriving (Show) + + +-- * Date and time + +-- | Year, month, day. +data Date = Date Int Int Int + deriving (Show) + +-- | Hour, minute, second. +-- +-- Hours over 23 are legal, representing the next day +-- relative to the start of a trip. +data Time = Time Int Int Int + deriving (Show) + + +-- * Type synonyms + +type AgencyID = String +type BlockID = String +type FareID = String +type RouteID = String +type ServiceID = String +type ShapeID = String +type StopID = String +type TripID = String +type ZoneID = String + +type URL = String +type Phone = String +type Timezone = String +type Language = String +type Currency = String +type Color = String + +type Sequence = Int +type Seconds = Int +type Distance = Double -- Rational? +type Price = Double -- Rational? +type LatLon = Double -- Rational? + +type TransferLimit = Maybe Int diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) Keegan McAllister 2010 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#! /usr/bin/runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/gtfs.cabal b/gtfs.cabal new file mode 100644 --- /dev/null +++ b/gtfs.cabal @@ -0,0 +1,32 @@ +name: gtfs +version: 0.1 +license: BSD3 +license-file: LICENSE +synopsis: The General Transit Feed Specification format +category: Data +author: Keegan McAllister +maintainer: Keegan McAllister +build-type: Simple +cabal-version: >=1.2 +description: + This module provides data types and parsers for the General Transit Feed + Specification, described at + . + . + GTFS is used by transit agencies to provide schedules, geographic + information, etc. to Google Maps and other Google applications. Many data + sets are available online, often with few restrictions, so the format is + useful to third-party developers. + +library + exposed-modules: + Data.GTFS.Types + , Data.GTFS.Parse + ghc-options: -Wall + build-depends: + base >= 3 && < 5 + , filepath >= 1.1 + , directory >= 1.0 + , csv >= 0.1 + , rowrecord >= 0.1 + , split >= 0.1