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