From e6cdfadd9893ff4489d2e667134ab07b189a1e7d Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Tue, 14 Nov 2023 23:04:37 +0100
Subject: [PATCH] sort platforms by level/layer

---
 app/Main.hs | 14 +++++++++++---
 1 file changed, 11 insertions(+), 3 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 77b9a77..2b702b9 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -9,6 +9,7 @@ import qualified Data.ByteString                      as BS
 import qualified Data.ByteString.Lazy                 as LB
 import           Data.Char
 import           Data.Csv                             hiding (lookup)
+import           Data.Either
 import           Data.Function                        ((&))
 import           Data.Functor                         ((<&>))
 import           Data.FuzzySet
@@ -20,10 +21,12 @@ import           Data.Ord
 import           Data.Text                            (Text)
 import qualified Data.Text                            as T
 import           Data.Text.Encoding                   (encodeUtf8)
+import qualified Data.Text.Read                       as T
 import           Data.Time.Clock
 import           Data.Tuple                           (swap)
 import           Data.Vector                          (Vector)
 import qualified Data.Vector                          as V
+import           GHC.Base                             (Alternative ((<|>)))
 import qualified Network.HTTP.Client                  as Client
 import qualified Network.HTTP.Client.OpenSSL          as Client
 import           Network.HTTP.Types
@@ -63,6 +66,7 @@ data Platform = Platform
   , osmId    :: Text
   , ref      :: Maybe Text
   , localRef :: Maybe Text
+  , osmLevel :: Maybe Text
   } deriving Show
 
 instance FromRecord Platform where
@@ -71,7 +75,8 @@ instance FromRecord Platform where
       v .! 0 <*>
       v .! 1 <*>
       v .! 2 <*>
-      v .! 3
+      v .! 3 <*>
+      (v .! 4 <|> v .! 5)
 
 data Answer
   = Redirect Text
@@ -145,7 +150,7 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
               | now `diffUTCTime` age < cacheTime && segment /= "fetch" -> pure answer
             _ -> do
               let overpassQuery = " \
-                 \[out:csv(::type, ::id, ref, local_ref;false)][timeout:25];\n\
+                 \[out:csv(::type, ::id, ref, local_ref, level, layer;false)][timeout:25];\n\
                  \node[~\"railway:ref|railway:ref:parent\"~\"^"<>encodeUtf8 (unRil100 ril100)<>"$\"][operator~\"^(DB |Deutsch)\"];\n\
                  \rel[public_transport~\"stop_area|stop_area_group\"](bn) -> .a;\n\
                  \rel[public_transport~\"stop_area|stop_area_group\"](br.a) -> .b;\n\
@@ -160,7 +165,10 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
               case decodeWith tsvOptions NoHeader (Client.responseBody response) of
                 Left _ -> pure Notfound
                 Right (platforms :: Vector Platform) -> do
-                  let answer = Html $ T.concat (renderPlatform <$> V.toList platforms)
+                  let answer = V.toList platforms
+                       & sortOn (maybe (-100 :: Int) (fromRight (-100) . fmap fst . T.signed T.decimal) . osmLevel)
+                       <&> renderPlatform
+                       & (Html . T.concat)
                   now <- getCurrentTime
                   atomically $ do
                     cache <- readTVar platformCache