bahnhof-name/tracks: display query on empty results

1 files changed, 15 insertions, 10 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 34442de..d73a617 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -20,7 +20,7 @@ import qualified Data.Map                             as M
 import           Data.Maybe                           (fromMaybe, mapMaybe)
 import           Data.Text                            (Text)
 import qualified Data.Text                            as T
-import           Data.Text.Encoding                   (encodeUtf8)
+import           Data.Text.Encoding                   (decodeUtf8, encodeUtf8)
 import qualified Data.Text.Read                       as T
 import           Data.Time.Clock
 import           Data.Vector                          (Vector)
@@ -164,15 +164,20 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
               response <- Client.httpLbs req clientManager
               case decodeWith tsvOptions NoHeader (Client.responseBody response) of
                 Left _ -> pure Notfound
-                Right (platforms :: Vector Platform) -> do
-                  let answer = V.toList platforms
-                       & sortOn (maybe (0::Int) (fromRight 0 . fmap fst . T.signed T.decimal) . osmLevel)
-                       <&> renderPlatform platforms
-                       & (Html . T.concat)
-                  atomically $ do
-                    cache <- readTVar platformCache
-                    writeTVar platformCache (M.insert ril100 (now, answer) cache)
-                  pure answer
+                Right (platforms :: Vector Platform)
+                  | null platforms -> pure $ Html $
+                      "Found no information, sorry.<br><br>If you want to investigate, the attempted query was:<br><br><pre>"
+                      <> decodeUtf8 overpassQuery
+                      <> "</pre>"
+                  | otherwise -> do
+                    let answer = V.toList platforms
+                         & sortOn (maybe (0::Int) (fromRight 0 . fmap fst . T.signed T.decimal) . osmLevel)
+                         <&> renderPlatform platforms
+                         & (Html . T.concat)
+                    atomically $ do
+                      cache <- readTVar platformCache
+                      writeTVar platformCache (M.insert ril100 (now, answer) cache)
+                    pure answer
                   where
                     getRef (Just ref) _       = Just ref
                     getRef Nothing (Just ref) = Just ref