diff --git a/app/Main.hs b/app/Main.hs
index 6712c62..3ec2cac 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
@@ -10,13 +11,13 @@ import qualified Data.ByteString.Lazy as LB
import Data.Char
import Data.Csv hiding (lookup)
import Data.Either
-import Data.Function ((&))
+import Data.Function (on, (&))
import Data.Functor ((<&>))
import Data.FuzzySet.Simple
import Data.List hiding (find)
import Data.Map (Map)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord
import Data.Text (Text)
import qualified Data.Text as T
@@ -62,11 +63,14 @@ findStationName query set = case sorted of
maybeHbf = filter (T.isInfixOf "Hbf" . snd) sorted
data Platform = Platform
- { osmType :: Text
- , osmId :: Text
- , ref :: Maybe Text
- , localRef :: Maybe Text
- , osmLevel :: Maybe Text
+ { osmType :: Text
+ , osmId :: Text
+ , ref :: Maybe Text
+ , localRef :: Maybe Text
+ , osmLevel :: Maybe Text
+ , osmPlatform :: Maybe Text
+ , osmSection :: Maybe Text
+ , osmPlatformEdge :: Maybe Text
} deriving Show
instance FromRecord Platform where
@@ -76,7 +80,10 @@ instance FromRecord Platform where
v .! 1 <*>
v .! 2 <*>
v .! 3 <*>
- (v .! 4 <|> v .! 5)
+ (v .! 4 <|> v .! 5) <*>
+ v .! 6 <*>
+ v .! 7 <*>
+ v .! 8
data Answer
= Redirect Text
@@ -150,13 +157,37 @@ 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, level, layer;false)][timeout:25];\n\
+ \[out:csv(::type, ::id, ref, local_ref, level, layer, platform, section, track;false)][timeout:25];\n\
\nwr[~\"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\
\(.a;.b;);\n\
\nwr[railway=platform](>>);\n\
- \out;\n"
+ \foreach {\n\
+ \ ._ -> .a;\n\
+ \ out tags;\n\
+ \ >> -> .p;\n\
+ \ nwr.p[\"railway\"=\"platform_edge\"][\"ref\"] -> .edges;\n\
+ \ if (edges.count(nwr) == 0) {\n\
+ \ >>;\n\
+ \ node._[\"railway:platform:section\"] -> ._;\n\
+ \ convert node platform = a.u(id()),\n\
+ \ section = t[\"railway:platform:section\"],\n\
+ \ ::id = id();\n\
+ \ out tags;\n\
+ \ } else { \n\
+ \ foreach.edges {\n\
+ \ ._ -> .b;\n\
+ \ >>;\n\
+ \ node._[\"railway:platform:section\"] -> ._;\n\
+ \ convert node platform = a.u(id()),\n\
+ \ section = t[\"railway:platform:section\"],\n\
+ \ track = b.u(t[\"ref\"]),\n\
+ \ ::id = id();\n\
+ \ out tags;\n\
+ \ }\n\
+ \ }\n\
+ \}\n"
let req = "https://overpass-api.de/api/interpreter"
{ Client.requestBody = Client.RequestBodyBS overpassQuery
, Client.method = "POST"}
@@ -167,9 +198,8 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
Right (platforms :: Vector Platform) -> do
let answer = V.toList platforms
& sortOn (maybe (0::Int) (fromRight 0 . fmap fst . T.signed T.decimal) . osmLevel)
- <&> renderPlatform
+ <&> renderPlatform platforms
& (Html . T.concat)
- now <- getCurrentTime
atomically $ do
cache <- readTVar platformCache
writeTVar platformCache (M.insert ril100 (now, answer) cache)
@@ -178,9 +208,25 @@ app AppData{..} request respond = mkAnswer >>= (respond . toResponse)
getRef (Just ref) _ = Just ref
getRef Nothing (Just ref) = Just ref
getRef _ _ = Nothing
- renderPlatform Platform{..} = case getRef ref localRef of
- Just ref -> "osmType<>"/"<>osmId<>"\">"<>ref<>"
"
+ renderPlatform others p = case getRef (ref p) (localRef p) of
+ Just ref -> mkAnchor p ref<>""<>renderedSections<>"
"
Nothing -> ""
+ where sectionGroups = others
+ & V.filter ((== Just (osmId p)) . osmPlatform)
+ & V.toList
+ & groupBy ((==) `on` osmPlatformEdge)
+ renderSectionGroup sections = if null sections then "" else sections
+ & sortOn osmSection
+ & mapMaybe (\p -> case osmSection p of Just s -> Just (mkAnchor p s) ; _ -> Nothing)
+ & intersperse ","
+ & ((osmPlatformEdge (head sections) & \case {Nothing -> ""; Just a -> a<>": "}) :)
+ & T.concat
+ renderedSections = if null sectionGroups then "" else sectionGroups
+ <&> renderSectionGroup
+ & (": " :)
+ & T.intercalate " "
+ mkAnchor p inner =
+ "osmType p<>"/"<>osmId p<>"\">"<>inner<>""
_ -> pure Notfound
queriedRil100 :: Text -> MatchResult Ril100 Text
queriedRil100 query = if