diff options
Diffstat (limited to '')
| -rw-r--r-- | app/Main.hs | 15 |
1 files changed, 15 insertions, 0 deletions
diff --git a/app/Main.hs b/app/Main.hs index b684ac3..d441b5e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -98,12 +98,16 @@ maybeAnswer = maybe Notfound newtype Ril100 = Ril100 { unRil100 :: Text } deriving (Eq, Ord, Show) +newtype RnvId = RnvId { unRnv :: Text } + deriving (Eq, Ord, Show) data AppData = AppData { ril100map :: DoubleMap Ril100 Text , 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)) @@ -129,6 +133,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 @@ -139,6 +146,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 @@ -298,6 +308,9 @@ main = do Right (leitpunkte :: V.Vector [Text]) <- LB.readFile "data/leitpunkte.csv" <&> decodeWith csvOptions HasHeader + Right (rnv :: V.Vector [Text]) <- + LB.readFile "data/rnv.csv" + <&> decode NoHeader putStrLn "building Index ..." let ril100set = addMany (V.toList (V.map (!! 2) betriebsstellenFiltered)) (emptySet 5 6 False) @@ -305,9 +318,11 @@ main = do let ril100map = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 1), line !! 2)) betriebsstellen let leitpunktMap = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 2), line !! 0)) leitpunkte + let rnvMap = mkDoubleMap $ fmap (\line -> (RnvId (line !! 1), line !! 0)) rnv 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 |