diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 13 |
1 files changed, 12 insertions, 1 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 |