diff options
| -rw-r--r-- | app/Main.hs | 67 |
1 files changed, 34 insertions, 33 deletions
diff --git a/app/Main.hs b/app/Main.hs index 0c004d5..132e132 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -86,45 +86,18 @@ app :: AppData -> Application app AppData{..} request respond = mkAnswer >>= (respond . toResponse) where mkAnswer :: IO Answer - mkAnswer = case filter (/= mempty) (pathInfo request) of - [] -> pure helptext - ["favicon.ico"] -> pure Notfound - ["cache"] -> do + mkAnswer = case unsnoc (filter (/= mempty) (pathInfo request)) of + Nothing -> pure helptext + Just ([], "favicon.ico") -> pure Notfound + Just ([], "cache") -> do cache <- readTVarIO platformCache now <- getCurrentTime M.toList cache & fmap (\(ril100, (age, _)) -> (T.pack . show) (unRil100 ril100, now `diffUTCTime` age)) & T.unlines & (pure . Plaintext) - [query] - | not (T.any isLower query) && host `elem` ["leitpunkt"] - -> lookupName query leitpunktMap - >>= (`lookupCode` ril100map) - & maybeAnswer Plaintext & pure - | not (T.any isLower query) && host `elem` ["rnv"] - -> lookupCode (RnvId query) rnvMap - & maybeAnswer Plaintext & pure - | not (T.any isLower query) - -> lookupCode (Ril100 query) ril100map - & maybeAnswer Plaintext & pure - | host `elem` ["leitpunkt"] - -> pure $ case findStationName query ril100set of - None -> Notfound - Exact (_,match) -> lookupName match ril100map - >>= (`lookupCode` leitpunktMap) - & maybeAnswer Plaintext - Fuzzy (_,match) -> Redirect (leitpunktBaseUrl <> "/" <> match) - | host `elem` ["rnv"] - -> lookupName query rnvMap - & maybeAnswer (Plaintext . unRnv) & pure - | otherwise - -> pure $ case findStationName query ril100set of - None -> Notfound - Exact (_,match) -> lookupName match ril100map - & maybeAnswer (Plaintext . unRil100) - Fuzzy (_,match) -> Redirect (ril100BaseUrl <> "/" <> match) - [query, segment] | segment `elem` ["gleis", "track", "tracks", "gleise", "platform", "platforms", "fetch"] - -> case queriedRil100 query of + Just (query, segment) | segment `elem` ["gleis", "track", "tracks", "gleise", "platform", "platforms", "fetch"] + -> case queriedRil100 (T.intercalate "/" query) of None -> pure Notfound Fuzzy url -> pure (Redirect (T.intercalate "/" [url, segment])) Exact ril100 -> do @@ -209,6 +182,34 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse) & T.intercalate " " mkAnchor p inner = "<a href=\"https://osm.org/"<>osmType p<>"/"<>osmId p<>"\">"<>inner<>"</a>" + Just _ + | not (T.any isLower query) && host `elem` ["leitpunkt"] + -> lookupName query leitpunktMap + >>= (`lookupCode` ril100map) + & maybeAnswer Plaintext & pure + | not (T.any isLower query) && host `elem` ["rnv"] + -> lookupCode (RnvId query) rnvMap + & maybeAnswer Plaintext & pure + | not (T.any isLower query) + -> lookupCode (Ril100 query) ril100map + & maybeAnswer Plaintext & pure + | host `elem` ["leitpunkt"] + -> pure $ case findStationName query ril100set of + None -> Notfound + Exact (_,match) -> lookupName match ril100map + >>= (`lookupCode` leitpunktMap) + & maybeAnswer Plaintext + Fuzzy (_,match) -> Redirect (leitpunktBaseUrl <> "/" <> match) + | host `elem` ["rnv"] + -> lookupName query rnvMap + & maybeAnswer (Plaintext . unRnv) & pure + | otherwise + -> pure $ case findStationName query ril100set of + None -> Notfound + Exact (_,match) -> lookupName match ril100map + & maybeAnswer (Plaintext . unRil100) + Fuzzy (_,match) -> Redirect (ril100BaseUrl <> "/" <> match) + where query = T.intercalate "/" (pathInfo request) _ -> pure Notfound queriedRil100 :: Text -> MatchResult Ril100 Text queriedRil100 query = if |