support for platform sectionsHEADmain

well this blew the query up ..

it attempts to do two things:
 - find platform sections grouped under platform_edges (important if
   platform sections of adjacent tracks don't line up)
 - if that fails, find any platforms somewhere under the whole platform
   object

This should (hopefully) cover most cases where platform sections are
actually mapped at all.

1 files changed, 60 insertions, 14 deletions

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 -> "<a href=\"https://osm.org/"<>osmType<>"/"<>osmId<>"\">"<>ref<>"</a><br>"
+                    renderPlatform others p = case getRef (ref p) (localRef p) of
+                      Just ref -> mkAnchor p ref<>"</a>"<>renderedSections<>"<br>"
                       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 =
+                              "<a href=\"https://osm.org/"<>osmType p<>"/"<>osmId p<>"\">"<>inner<>"</a>"
       _ -> pure Notfound
     queriedRil100 :: Text -> MatchResult Ril100 Text
     queriedRil100 query = if