sort platforms by level/layer
This commit is contained in:
parent
02b29877f4
commit
e6cdfadd98
1 changed files with 11 additions and 3 deletions
14
app/Main.hs
14
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
|
||||
|
|
Loading…
Reference in a new issue