use OsPath instead of FilePath in easy cases

this is still far from being supported by most libraries, but does make
it possible to remove some uses of String (though most times, there is a
conversion back to String later).

Note that using the default.nix now only works on nixpkgs-unstable for a
bit; using the newer filepath package on stable leads to broken other packages.

6 files changed, 44 insertions, 22 deletions

diff --git a/default.nix b/default.nix
index d6ce56c..4b317b9 100644
--- a/default.nix
+++ b/default.nix
@@ -7,7 +7,7 @@ let
   f = { mkDerivation, aeson, base, blaze-html, blaze-markup
       , bytestring, cassava, conduit, conferer, conferer-aeson
       , conferer-warp, conferer-yaml, containers, data-default-class
-      , directory, either, exceptions, extra, fmt, hoauth2, http-api-data
+      , directory, either, exceptions, extra, filepath, fmt, hoauth2, http-api-data
       , http-media, insert-ordered-containers, lens, lib, monad-logger
       , mtl, path-pieces, persistent, persistent-postgresql
       , prometheus-client, prometheus-metrics-ghc, proto-lens
@@ -27,7 +27,7 @@ let
         isExecutable = true;
         libraryHaskellDepends = [
           aeson base blaze-html blaze-markup bytestring cassava conduit
-          conferer conferer-warp containers either exceptions extra fmt
+          conferer conferer-warp containers either exceptions extra fmt filepath
           hoauth2 http-api-data http-media insert-ordered-containers lens
           monad-logger mtl path-pieces persistent persistent-postgresql
           prometheus-client prometheus-metrics-ghc proto-lens
@@ -63,6 +63,7 @@ let
   # (currently kept as a dummy)
   hpkgs = haskellPackages.override {
     overrides = self: super: with pkgs.haskell.lib.compose; {
+      # filepath = self.filepath_1_4_100_4;
       # conferer-warp = markUnbroken super.conferer-warp;
     };
   };
diff --git a/lib/Config.hs b/lib/Config.hs
index 4aa62fc..ef90fc1 100644
--- a/lib/Config.hs
+++ b/lib/Config.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE QuasiQuotes     #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Config (UffdConfig(..), ServerConfig(..), LoggingConfig(..)) where
@@ -9,6 +10,7 @@ import           Data.Functor             ((<&>))
 import           Data.Text                (Text)
 import           GHC.Generics             (Generic)
 import           Network.Wai.Handler.Warp (Settings)
+import           System.OsPath            (OsPath, osp)
 import           URI.ByteString
 
 data UffdConfig = UffdConfig
@@ -21,9 +23,9 @@ data UffdConfig = UffdConfig
 data ServerConfig = ServerConfig
   { serverConfigWarp         :: Settings
   , serverConfigDbString     :: ByteString
-  , serverConfigGtfs         :: FilePath
-  , serverConfigAssets       :: FilePath
-  , serverConfigZoneinfoPath :: FilePath
+  , serverConfigGtfs         :: OsPath
+  , serverConfigAssets       :: OsPath
+  , serverConfigZoneinfoPath :: OsPath
   , serverConfigDebugMode    :: Bool
   , serverConfigLogin        :: UffdConfig
   , serverConfigLogging      :: LoggingConfig
@@ -41,9 +43,9 @@ instance DefaultConfig ServerConfig where
   configDef = ServerConfig
     { serverConfigWarp = configDef
     , serverConfigDbString = ""
-    , serverConfigGtfs = "./gtfs.zip"
-    , serverConfigAssets = "./assets"
-    , serverConfigZoneinfoPath = "/etc/zoneinfo/"
+    , serverConfigGtfs = [osp|./gtfs.zip|]
+    , serverConfigAssets = [osp|./assets|]
+    , serverConfigZoneinfoPath = [osp|/etc/zoneinfo/|]
     , serverConfigDebugMode = False
     , serverConfigLogin = configDef
     , serverConfigLogging = configDef
diff --git a/lib/GTFS.hs b/lib/GTFS.hs
index cb9be2a..4f3a311 100644
--- a/lib/GTFS.hs
+++ b/lib/GTFS.hs
@@ -65,6 +65,8 @@ import           Data.Time.LocalTime.TimeZone.Olson  (getTimeZoneSeriesFromOlson
 import           Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries,
                                                       timeZoneFromSeries)
 import           GHC.Float                           (int2Double)
+import           System.OsPath                       (OsPath, decodeUtf,
+                                                      encodeUtf, (</>))
 
 
 -- | for some reason this doesn't exist already in cassava
@@ -499,9 +501,9 @@ data GTFS = GTFS
   }
 
 
-loadRawGtfs :: FilePath -> IO RawGTFS
+loadRawGtfs :: OsPath -> IO RawGTFS
 loadRawGtfs path = do
-    bytes <- LB.readFile path
+    bytes <- decodeUtf path >>= LB.readFile
     let zip = Zip.toArchive bytes
     RawGTFS
       <$> decodeTable' "stops.txt" zip
@@ -531,7 +533,7 @@ loadRawGtfs path = do
 --
 -- 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 :: OsPath -> OsPath -> IO GTFS
 loadGtfs path zoneinforoot = do
     shallow@RawGTFS{..} <- loadRawGtfs path
     -- TODO: sort these according to sequence numbers
@@ -541,7 +543,11 @@ loadGtfs path zoneinforoot = 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 (zoneinforoot<>T.unpack tzname)
+
+    tzsuffix <- encodeUtf (T.unpack tzname)
+    tzseries <- decodeUtf (zoneinforoot </> tzsuffix)
+      >>= getTimeZoneSeriesFromOlsonFile
+
     let agencies' = fmap (\a -> a { agencyTimezone = tzseries }) rawAgencies
     routes' <- V.mapM (pushRoute agencies') rawRoutes
       <&> mapFromVector routeId
diff --git a/lib/Server.hs b/lib/Server.hs
index 15027b3..3fc2c5a 100644
--- a/lib/Server.hs
+++ b/lib/Server.hs
@@ -36,7 +36,6 @@ import           Prometheus                  (Info (Info), exportMetricsAsText,
                                               gauge, register)
 import           Prometheus.Metric.GHC       (ghcMetrics)
 import           Servant                     (Application, err401, serve,
-                                              serveDirectoryFileServer,
                                               throwError)
 import           Servant.API                 ((:<|>) (..))
 import           Servant.Server              (hoistServer)
@@ -47,7 +46,8 @@ import           Server.GTFS_RT              (gtfsRealtimeServer)
 import           Server.Ingest               (handleTrackerRegister,
                                               handleTrainPing, handleWS)
 import           Server.Subscribe            (handleSubscribe)
-import           Server.Util                 (Service, runLogging, runService)
+import           Server.Util                 (Service, runLogging, runService,
+                                              serveDirectoryFileServer)
 import           System.IO.Unsafe            (unsafePerformIO)
 import           Yesod                       (toWaiAppPlain)
 
diff --git a/lib/Server/Util.hs b/lib/Server/Util.hs
index 290b9c5..b519a86 100644
--- a/lib/Server/Util.hs
+++ b/lib/Server/Util.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE BlockArguments  #-}
 {-# LANGUAGE RecordWildCards #-}
 -- | mostly the monad the service runs in
-module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging, getTzseries) where
+module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging, getTzseries, serveDirectoryFileServer) where
 
 import           Config                              (LoggingConfig (..),
                                                       ServerConfig (..))
@@ -27,14 +27,18 @@ import           Data.Time                           (Day, UTCTime (..),
 import           Data.Time.LocalTime.TimeZone.Olson  (getTimeZoneSeriesFromOlsonFile)
 import           Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries)
 import           Fmt                                 ((+|), (|+))
+import           GHC.IO                              (unsafePerformIO)
 import           GHC.IO.Exception                    (IOException (IOError))
 import           GTFS                                (Seconds (..))
 import           Prometheus                          (MonadMonitor (doIO))
+import qualified Servant
 import           Servant                             (Handler, ServerError,
                                                       ServerT, err404, errBody,
                                                       errHeaders, throwError)
-import           System.FilePath                     ((</>))
 import           System.IO                           (stderr)
+import           System.OsPath                       (OsPath, decodeFS,
+                                                      decodeUtf, encodeUtf,
+                                                      (</>))
 import           System.Process.Extra                (callProcess)
 
 type ServiceM  = LoggingT (ReaderT LoggingConfig Handler)
@@ -87,5 +91,13 @@ utcToSeconds time day =
   Seconds $ round $ nominalDiffTimeToSeconds $ diffUTCTime time (UTCTime day 0)
 
 getTzseries :: ServerConfig -> Text -> IO TimeZoneSeries
-getTzseries settings tzname = getTimeZoneSeriesFromOlsonFile
-        (serverConfigZoneinfoPath settings </> T.unpack tzname)
+getTzseries settings tzname = do
+  suffix <- encodeUtf (T.unpack tzname)
+  -- TODO: submit a patch to timezone-olson making it accept OsPath
+  legacyPath <- decodeFS (serverConfigZoneinfoPath settings </> suffix)
+  getTimeZoneSeriesFromOlsonFile legacyPath
+
+-- TODO: patch servant / wai to use OsPath?
+serveDirectoryFileServer :: OsPath -> ServerT Servant.Raw m
+serveDirectoryFileServer =
+  Servant.serveDirectoryFileServer . unsafePerformIO . decodeUtf
diff --git a/tracktrain.cabal b/tracktrain.cabal
index 3c3d72f..45ba246 100644
--- a/tracktrain.cabal
+++ b/tracktrain.cabal
@@ -15,7 +15,7 @@ extra-source-files: CHANGELOG.md
 executable tracktrain
     main-is:          Main.hs
     ghc-options: -threaded -rtsopts
-    build-depends:    base ^>=4.17
+    build-depends:    base
                     , bytestring ^>= 0.11
                     , fmt >= 0.6.3.0
                     , time 
@@ -33,6 +33,7 @@ executable tracktrain
                     , directory
                     , extra
                     , proto-lens
+                    , filepath >= 1.4.100
     hs-source-dirs:   app
     default-language: GHC2021
     default-extensions: OverloadedStrings
@@ -40,7 +41,7 @@ executable tracktrain
 
 
 library
-    build-depends:    base ^>=4.17
+    build-depends:    base
                     , gtfs-realtime
                     , zip-archive
                     , cassava >= 0.5.2.0
@@ -96,7 +97,7 @@ library
                     , exceptions
                     , proto-lens
                     , http-media
-                    , filepath
+                    , filepath >= 1.4.100
                     , monad-control
     hs-source-dirs:   lib
     exposed-modules: GTFS
@@ -127,7 +128,7 @@ library
                       , ViewPatterns
 
 library gtfs-realtime
-    build-depends: base ^>=4.17
+    build-depends: base
              , proto-lens-runtime
     default-language: Haskell2010
     hs-source-dirs: gtfs-realtime