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 & T.unlines
& (pure . Plaintext) & (pure . Plaintext)
[query] [query]
| T.all isUpper query && host `elem` ["leitpunkt"] | not (T.any isLower query) && host `elem` ["leitpunkt"]
-> lookupName query leitpunktMap -> lookupName query leitpunktMap
>>= (`lookupCode` ril100map) >>= (`lookupCode` ril100map)
& maybeAnswer Plaintext & pure & maybeAnswer Plaintext & pure
| T.all isUpper query | not (T.any isLower query)
-> lookupCode (Ril100 query) ril100map -> lookupCode (Ril100 query) ril100map
& maybeAnswer Plaintext & pure & maybeAnswer Plaintext & pure
| host `elem` ["leitpunkt"] | host `elem` ["leitpunkt"]
@ -184,10 +184,10 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
_ -> pure Notfound _ -> pure Notfound
queriedRil100 :: Text -> MatchResult Ril100 Text queriedRil100 :: Text -> MatchResult Ril100 Text
queriedRil100 query = if queriedRil100 query = if
| T.all isUpper query && host `elem` ["leitpunkt"] | not (T.any isLower query) && host `elem` ["leitpunkt"]
-> lookupName query leitpunktMap -> lookupName query leitpunktMap
& maybe None Exact & maybe None Exact
| T.all isUpper query | not (T.any isLower query)
-> Exact (Ril100 query) -> Exact (Ril100 query)
| host `elem` ["leitpunkt"] | host `elem` ["leitpunkt"]
-> case findStationName query ril100set of -> case findStationName query ril100set of
@ -246,13 +246,14 @@ main = do
Right (betriebsstellen :: V.Vector [Text]) <- Right (betriebsstellen :: V.Vector [Text]) <-
LB.readFile "data/DBNetz-Betriebsstellenverzeichnis-Stand2021-10.csv" LB.readFile "data/DBNetz-Betriebsstellenverzeichnis-Stand2021-10.csv"
<&> decodeWith csvOptions HasHeader <&> 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]) <- Right (leitpunkte :: V.Vector [Text]) <-
LB.readFile "data/leitpunkte.csv" LB.readFile "data/leitpunkte.csv"
<&> decodeWith csvOptions HasHeader <&> decodeWith csvOptions HasHeader
putStrLn "building Index ..." 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") putStrLn (seq ril100set "done")
let ril100map = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 1), line !! 2)) betriebsstellen let ril100map = mkDoubleMap $ fmap (\line -> (Ril100 (line !! 1), line !! 2)) betriebsstellen