From 5a0ee2039803b555b0702f717b3418f59e2121ac Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Wed, 29 Nov 2023 18:33:54 +0100
Subject: [PATCH] allow exact lookups of obscure Ril100 codes

---
 app/Main.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 60f2e35..6889733 100644
--- a/app/Main.hs
+++ b/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