diff options
| -rw-r--r-- | app/Main.hs | 13 | ||||
| -rw-r--r-- | app/Util.hs | 13 |
2 files changed, 21 insertions, 5 deletions
diff --git a/app/Main.hs b/app/Main.hs index ad7a575..b6ba540 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -100,6 +100,7 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) -> case queriedRil100 (T.intercalate "/" query) of None -> pure Notfound Fuzzy url -> pure (Redirect (T.intercalate "/" [url, segment])) + Ambiguous possibilities -> pure (listOfCompletions possibilities) Exact ril100 -> do maybeCache <- readTVarIO platformCache <&> M.lookup ril100 now <- getCurrentTime @@ -196,6 +197,7 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) | host `elem` ["leitpunkt"] -> pure $ case findStationName query ril100set of None -> Notfound + Ambiguous possibilities -> listOfLinks leitpunktBaseUrl possibilities Exact (_,match) -> lookupName match ril100map >>= (`lookupCode` leitpunktMap) & maybeAnswer Plaintext @@ -206,11 +208,12 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) | otherwise -> pure $ case findStationName query ril100set of None -> Notfound + Ambiguous possibilities -> listOfLinks ril100BaseUrl possibilities Exact (_,match) -> lookupName match ril100map & maybeAnswer (Plaintext . unRil100) Fuzzy (_,match) -> Redirect (ril100BaseUrl <> "/" <> match) where query = T.intercalate "/" (pathInfo request) - queriedRil100 :: Text -> MatchResult Ril100 Text + queriedRil100 :: Text -> MatchResult Ril100 Text (Text, Text) queriedRil100 query = if | not (T.any isLower query) && host `elem` ["leitpunkt"] -> lookupName query leitpunktMap @@ -220,6 +223,7 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) | otherwise -> case findStationName query ril100set of None -> None + Ambiguous possibilities -> Ambiguous (fmap (\(_, t) -> (baseUrl <> "/" <> t, t)) possibilities) Exact (_,match) -> lookupName match ril100map & maybe None Exact Fuzzy (_,match) -> Fuzzy (baseUrl <> "/" <> match) @@ -266,6 +270,13 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) , ("x-data-by", "OpenStreetMap Contributors https://www.openstreetmap.org/copyright/") , ("x-sources-at", "https://stuebinm.eu/git/bahnhof.name") ] + listOfCompletions possibilities = possibilities + & fmap (\(href, text) -> "<a href=\"" <> href <> "\">" <> text <> "</a>") + & T.intercalate "<br>" + & Html + listOfLinks baseUrl possibilities = possibilities + & fmap (\(_, t) -> (baseUrl <> "/" <> t, t)) + & listOfCompletions diff --git a/app/Util.hs b/app/Util.hs index eefff84..ee8a5e6 100644 --- a/app/Util.hs +++ b/app/Util.hs @@ -23,9 +23,10 @@ import qualified Data.Vector as V import Text.FuzzyFind (Alignment (score), bestMatch) -data MatchResult a b +data MatchResult a b c = Exact a | Fuzzy b + | Ambiguous [c] | None deriving Show @@ -41,18 +42,22 @@ data DoubleMap code long = DoubleMap , back :: Map long code } -findStationName :: T.Text -> FuzzySet -> MatchResult (Double, Text) (Double, Text) +findStationName :: T.Text -> FuzzySet -> MatchResult (Double, Text) (Double, Text) (Double, Text) findStationName query set = case sorted of [exact] -> Exact exact _ -> case maybeHbf of station:_ -> Fuzzy station _ -> case results of - station:_ -> Fuzzy station - _ -> None + [] -> None + [station] -> Fuzzy station + s1:s2:_ + | fst s1 - fst s2 < 10 -> Ambiguous $ (takeWhile ((> fst s1 - 10) . fst) results) + | otherwise -> Fuzzy s1 where sorted = results & fmap (\(_, match) -> (fromIntegral . maybe 0 score . bestMatch (T.unpack query) $ T.unpack match, match)) & sortOn (Down . fst) + -- check if difference between first two is <10 or such results = find query set maybeHbf = filter (T.isInfixOf "Hbf" . snd) sorted |