forks/bahnhof.name
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

allow exact lookups of obscure Ril100 codes

Browse source
This commit is contained in:
stuebinm 2023-11-29 18:33:54 +01:00
parent 783bf8859a
commit 5a0ee20398
1 changed files with 7 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
app/Main.hs
View file

@ -118,11 +118,11 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
& T.unlines
& (pure . Plaintext)
[query]
| T.all isUpper query && host `elem` ["leitpunkt"]
| not (T.any isLower query) && host `elem` ["leitpunkt"]
-> lookupName query leitpunktMap
>>= (`lookupCode` ril100map)
& maybeAnswer Plaintext & pure
| T.all isUpper query
| not (T.any isLower query)
-> lookupCode (Ril100 query) ril100map
& maybeAnswer Plaintext & pure
| host `elem` ["leitpunkt"]
@ -184,10 +184,10 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
_ -> pure Notfound
queriedRil100 :: Text -> MatchResult Ril100 Text
queriedRil100 query = if
| T.all isUpper query && host `elem` ["leitpunkt"]
| not (T.any isLower query) && host `elem` ["leitpunkt"]
-> lookupName query leitpunktMap
& maybe None Exact
| T.all isUpper query
| not (T.any isLower query)
-> Exact (Ril100 query)
| host `elem` ["leitpunkt"]
-> case findStationName query ril100set of
@ -246,13 +246,14 @@ main = do
Right (betriebsstellen :: V.Vector [Text]) <-
LB.readFile "data/DBNetz-Betriebsstellenverzeichnis-Stand2021-10.csv"
<&> decodeWith csvOptions HasHeader
<&> fmap (V.filter (\line -> line !! 4 `notElem` ["BUSH", "LGR", "ÜST", "BFT", "ABZW", "BK", "AWAN", "ANST", "LGR"]))
let betriebsstellenFiltered = betriebsstellen
& V.filter (\line -> line !! 4 `notElem` ["BUSH", "LGR", "ÜST", "BFT", "ABZW", "BK", "AWAN", "ANST", "LGR"])
Right (leitpunkte :: V.Vector [Text]) <-
LB.readFile "data/leitpunkte.csv"
<&> decodeWith csvOptions HasHeader
putStrLn "building Index ..."
let ril100set = addMany (emptySet 5 6 False) (V.toList (V.map (!! 2) betriebsstellen))
let ril100set = addMany (emptySet 5 6 False) (V.toList (V.map (!! 2) betriebsstellenFiltered))
putStrLn (seq ril100set "done")
let ril100map = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 1), line !! 2)) betriebsstellen