allow exact lookups of obscure Ril100 codes
This commit is contained in:
parent
783bf8859a
commit
5a0ee20398
1 changed files with 7 additions and 6 deletions
13
app/Main.hs
13
app/Main.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue