From f7066888652ed3326017adf2eb6786a21043ebf5 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 28 Aug 2022 21:33:33 +0200
Subject: some config thing

works kinda well, but doesn't complain about unknown config values in
json, which is kinda hmpf tbh
---
 lib/GTFS.hs | 48 ++++++++++++++++++++++++++----------------------
 1 file changed, 26 insertions(+), 22 deletions(-)

(limited to 'lib/GTFS.hs')

diff --git a/lib/GTFS.hs b/lib/GTFS.hs
index 2047d56..9eed8b5 100644
--- a/lib/GTFS.hs
+++ b/lib/GTFS.hs
@@ -1,19 +1,18 @@
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveAnyClass             #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE DerivingStrategies         #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase                 #-}
-{-# LANGUAGE NamedFieldPuns             #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-{-# LANGUAGE StandaloneKindSignatures   #-}
-{-# LANGUAGE TupleSections              #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DeriveAnyClass           #-}
+{-# LANGUAGE DeriveGeneric            #-}
+{-# LANGUAGE DerivingStrategies       #-}
+{-# LANGUAGE FlexibleContexts         #-}
+{-# LANGUAGE FlexibleInstances        #-}
+{-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE RecordWildCards          #-}
+{-# LANGUAGE StandaloneDeriving       #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TupleSections            #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE TypeFamilies             #-}
+{-# LANGUAGE UndecidableInstances     #-}
 
 -- | All kinds of stuff that has to deal with GTFS directly
 -- (i.e. parsing, querying, Aeson instances, etc.)
@@ -467,7 +466,7 @@ data GTFS = GTFS
 
 loadRawGtfs :: FilePath -> IO RawGTFS
 loadRawGtfs path = do
-    zip <- Zip.toArchive <$> LB.readFile "./gtfs.zip"
+    zip <- Zip.toArchive <$> LB.readFile path
     RawGTFS
       <$> decodeTable' "stops.txt" zip
       <*> decodeTable' "stop_times.txt" zip
@@ -490,8 +489,13 @@ loadRawGtfs path = do
           Nothing -> fail $ "required file "+|path|+" not found in gtfs.zip"
           Just a  -> pure a
 
-loadGtfs :: FilePath -> IO GTFS
-loadGtfs path = do
+-- | load a gtfs file "the complicated way", creating data structures much nicer
+-- to work with than the raw representation of GTFS.
+--
+-- Note that this additionally needs a path to the machine's timezone info
+-- (usually /etc/zoneinfo or /usr/shared/zoneinfo)
+loadGtfs :: FilePath -> FilePath -> IO GTFS
+loadGtfs path zoneinforoot = do
     shallow@RawGTFS{..} <- loadRawGtfs path
     -- TODO: sort these according to sequence numbers
     let shapes =
@@ -500,9 +504,9 @@ loadGtfs path = do
           (fromMaybe mempty rawShapePoints)
     -- all agencies must have the same timezone, so just take the first's
     let tzname = agencyTimezone $ V.head rawAgencies
-    tzseries <- getTimeZoneSeriesFromOlsonFile (T.unpack $ "/etc/zoneinfo/"<>tzname)
+    tzseries <- getTimeZoneSeriesFromOlsonFile (zoneinforoot<>T.unpack tzname)
     let agencies' = fmap (\a -> a { agencyTimezone = tzseries }) rawAgencies
-    routes' <- V.mapM (\raw -> pushRoute agencies' raw) rawRoutes
+    routes' <- V.mapM (pushRoute agencies') rawRoutes
       <&> mapFromVector routeId
     stops' <- V.mapM (pushStop tzseries tzname rawStations) rawStops
     trips' <- V.mapM (pushTrip routes' stops' shapes) rawTrips
@@ -573,7 +577,7 @@ loadGtfs path = do
 
 
       sortShapePoint :: ShapePoint -> Map Text Shape -> Map Text Shape
-      sortShapePoint ShapePoint{..} shapes = M.alter appendPoint shapePtId shapes
+      sortShapePoint ShapePoint{..} = M.alter appendPoint shapePtId
         where
           point = (shapePtLat, shapePtLong)
           appendPoint = \case
-- 
cgit v1.2.3