rnv.bahnhof.name: draft

2 files changed, 22 insertions, 2 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 34442de..b03cdd1 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -73,6 +73,8 @@ data AppData = AppData
   , leitpunktMap     :: DoubleMap Ril100 Text
   , ril100set        :: FuzzySet
   , ril100BaseUrl    :: Text
+  , rnvBaseUrl       :: Text
+  , rnvMap           :: DoubleMap RnvId Text
   , leitpunktBaseUrl :: Text
   , clientManager    :: Client.Manager
   , platformCache    :: TVar (Map Ril100 (UTCTime, Answer))
@@ -98,6 +100,9 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
           -> lookupName query leitpunktMap
             >>= (`lookupCode` ril100map)
             & maybeAnswer Plaintext & pure
+        | not (T.any isLower query) && host `elem` ["rnv"]
+          -> lookupCode (RnvId query) rnvMap
+            & maybeAnswer Plaintext & pure
         | not (T.any isLower query)
           -> lookupCode (Ril100 query) ril100map
             & maybeAnswer Plaintext & pure
@@ -108,6 +113,9 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
               >>= (`lookupCode` leitpunktMap)
               & maybeAnswer Plaintext
             Fuzzy (_,match) -> Redirect (leitpunktBaseUrl <> "/" <> match)
+        | host `elem` ["rnv"]
+          -> lookupName query rnvMap
+            & maybeAnswer (Plaintext . unRnv) & pure
         | otherwise
           -> pure $ case findStationName query ril100set of
             None -> Notfound
@@ -252,11 +260,12 @@ main :: IO ()
 main = do
   StaticAppData {..} <- readData
 
-  putStrLn "Building index…"
-  putStrLn (seq ril100set "Index generated.")
+  putStrLn "building Index ..."
+  putStrLn (seq ril100set "done")
 
   let ril100BaseUrl = "https://ril100.bahnhof.name"
   let leitpunktBaseUrl = "https://leitpunkt.bahnhof.name"
+  let rnvBaseUrl = "https://rnv.bahnhof.name"
   let cacheTime = 3600 * 24 * 7 -- one week
 
   platformCache <- newTVarIO mempty
diff --git a/app/Util.hs b/app/Util.hs
index ce3dcbc..094f229 100644
--- a/app/Util.hs
+++ b/app/Util.hs
@@ -33,6 +33,7 @@ data StaticAppData = StaticAppData
   { ril100map    :: DoubleMap Ril100 Text
   , leitpunktMap :: DoubleMap Ril100 Text
   , ril100set    :: FuzzySet
+  , rnvMap       :: DoubleMap RnvId Text
   }
 
 data DoubleMap code long = DoubleMap
@@ -58,6 +59,8 @@ findStationName query set = case sorted of
 newtype Ril100 = Ril100 { unRil100 :: Text }
   deriving (Eq, Ord, Show)
 
+newtype RnvId = RnvId { unRnv :: Text }
+  deriving (Eq, Ord, Show)
 
 lookupCode :: Ord code => code -> DoubleMap code long -> Maybe long
 lookupCode code maps = M.lookup code (there maps)
@@ -83,11 +86,19 @@ readLeitpunktMap = do
     <&> decodeWith csvOptions HasHeader
   return $ mkDoubleMap $ fmap (\line -> (Ril100 (line !! 2), line !! 0)) leitpunkte
 
+readRnvMap :: IO (DoubleMap RnvId Text)
+readRnvMap = do
+  Right (rnv :: V.Vector [Text]) <-
+    LB.readFile "data/rnv.csv"
+    <&> decode NoHeader
+  return $ mkDoubleMap $ fmap (\line -> (RnvId (line !! 1), line !! 0)) rnv
+
 readData :: IO StaticAppData
 readData = do
   putStrLn "Parsing input .csv files…"
   betriebsstellen <- readBetriebsstellen
   leitpunktMap    <- readLeitpunktMap
+  rnvMap          <- readRnvMap
   putStrLn "Static data ready."
 
   let betriebsstellenFiltered = betriebsstellen