retrieve unique routes from otp and ignore walk legs below a configur…

…able threshold value

lib/mobility-core/src/Kernel/External/MultiModal/Interface/OpenTripPlanner.hs

@@ -43,6 +43,7 @@ getTransitRoutes cfg req = do
   let planClient = fromString (showBaseUrl cfg.baseUrl)
   let transportModes' = req.transportModes
   let numItineraries' = Just 7
+  let minimumWalkDistance = req.minimumWalkDistance
   resp <-
     liftIO $
       planClient
@@ -58,4 +59,4 @@ getTransitRoutes cfg req = do
   case resp of
     Left _ -> pure Nothing
     Right plan' ->
-      pure $ Just $ convertOTPToGeneric plan'
+      pure $ Just $ convertOTPToGeneric plan' minimumWalkDistance

lib/mobility-core/src/Kernel/External/MultiModal/Interface/Types.hs

@@ -47,7 +47,8 @@ data MultiModalRouteDetails = MultiModalRouteDetails
   { gtfsId :: Maybe Text,
     longName :: Maybe Text,
     shortName :: Maybe Text,
-    color :: Maybe Text
+    color :: Maybe Text,
+    frequency :: Maybe Time.Seconds
   }
   deriving (Show, Generic, ToJSON, FromJSON, ToSchema)
 
@@ -60,13 +61,12 @@ data MultiModalLeg = MultiModalLeg
     endLocation :: GT.LocationV2,
     fromStopDetails :: Maybe MultiModalStopDetails,
     toStopDetails :: Maybe MultiModalStopDetails,
-    routeDetails :: [MultiModalRouteDetails],
+    routeDetails :: Maybe MultiModalRouteDetails,
     agency :: Maybe MultiModalAgency,
     fromArrivalTime :: Maybe UTCTime,
     fromDepartureTime :: Maybe UTCTime,
     toArrivalTime :: Maybe UTCTime,
-    toDepartureTime :: Maybe UTCTime,
-    frequency :: Maybe Time.Seconds
+    toDepartureTime :: Maybe UTCTime
   }
   deriving (Show, Generic, ToJSON, FromJSON, ToSchema)
 
@@ -89,6 +89,7 @@ data GetTransitRoutesReq = GetTransitRoutesReq
     departureTime :: Maybe UTCTime,
     mode :: Maybe GT.ModeV2,
     transitPreferences :: Maybe GT.TransitPreferencesV2,
-    transportModes :: Maybe [Maybe OTPTypes.TransportMode]
+    transportModes :: Maybe [Maybe OTPTypes.TransportMode],
+    minimumWalkDistance :: Distance.Meters
   }
   deriving (Generic, ToJSON, FromJSON, Show, ToSchema)

lib/mobility-core/src/Kernel/External/MultiModal/Utils.hs

@@ -8,7 +8,7 @@ where
 
 import qualified Data.Char as Char
 import qualified Data.HashMap.Strict as HM
-import Data.List (sort)
+import Data.List (nub, sort)
 import qualified Data.Map as Map
 import Data.Maybe
 import qualified Data.Text as T
@@ -183,8 +183,7 @@ convertGoogleToGeneric gResponse =
               fromDepartureTime = fromDepartureTime',
               toArrivalTime = toArrivalTime',
               toDepartureTime = toDepartureTime',
-              routeDetails = [],
-              frequency = Nothing
+              routeDetails = Nothing --[]
             } :
           genericLegs
     mergeWalkingLegs :: [MultiModalLeg] -> [MultiModalLeg]
@@ -224,8 +223,7 @@ convertGoogleToGeneric gResponse =
               fromDepartureTime = leg1.fromDepartureTime,
               toArrivalTime = leg2.toArrivalTime,
               toDepartureTime = leg2.toDepartureTime,
-              routeDetails = leg1.routeDetails,
-              frequency = Nothing
+              routeDetails = leg1.routeDetails
             }
     adjustWalkingLegs :: [MultiModalLeg] -> [MultiModalLeg]
     adjustWalkingLegs [] = []
@@ -241,60 +239,69 @@ convertGoogleToGeneric gResponse =
               else leg2
        in adjustedLeg1 : adjustWalkingLegs (adjustedLeg2 : rest)
 
-convertOTPToGeneric :: OTP.OTPPlan -> MultiModalResponse
-convertOTPToGeneric otpResponse =
+convertOTPToGeneric :: OTP.OTPPlan -> Distance.Meters -> MultiModalResponse
+convertOTPToGeneric otpResponse minimumWalkDistance =
   let itineraries = otpResponse.plan.itineraries
       (genericRoutes, frequencyMap) = foldr accumulateItineraries ([], HM.empty) itineraries
-      mergedRoutes = map mergeConsecutiveMetroLegs genericRoutes
-      updatedRoutes = map (updateRouteFrequency frequencyMap) mergedRoutes
-      finalRoutes = uniqueRoutes updatedRoutes
+      --mergedRoutes = map mergeConsecutiveMetroLegs genericRoutes
+      updatedRoutes = map (updateRouteFrequency frequencyMap) genericRoutes
+      filteredRoutes = map (removeShortWalkLegs minimumWalkDistance) updatedRoutes
+      finalRoutes = uniqueRoutes filteredRoutes
    in MultiModalResponse
         { routes = finalRoutes
         }
   where
-    -- Merge consecutive MetroRail legs in a route
-    mergeConsecutiveMetroLegs :: MultiModalRoute -> MultiModalRoute
-    mergeConsecutiveMetroLegs route =
-      let mergedLegs = mergeMetroLegs route.legs
-       in route {legs = mergedLegs}
+    removeShortWalkLegs :: Distance.Meters -> MultiModalRoute -> MultiModalRoute
+    removeShortWalkLegs threshold route =
+      let filteredLegs = filter (\leg -> not (leg.mode == Walk && getLegDistance leg < thresholdValue)) route.legs
+          thresholdValue = fromIntegral $ Distance.getMeters threshold -- Convert threshold to Double for comparison
+       in route {legs = filteredLegs}
 
-    -- Recursive function to merge consecutive MetroRail legs
-    mergeMetroLegs :: [MultiModalLeg] -> [MultiModalLeg]
-    mergeMetroLegs [] = []
-    mergeMetroLegs [leg] = [leg] -- Single leg, no merging needed
-    mergeMetroLegs (leg1 : leg2 : rest)
-      | leg1.mode == MetroRail && leg2.mode == MetroRail && leg1.agency == leg2.agency =
-        let leg1Start = leg1.startLocation
-            leg2Start = leg2.startLocation
-            leg2End = leg2.endLocation
-            encodedPolylineText = encode [leg1Start.latLng, leg2Start.latLng, leg2End.latLng]
-            mergedLeg =
-              MultiModalLeg
-                { distance =
-                    Distance.Distance
-                      { value =
-                          Distance.HighPrecDistance
-                            { getHighPrecDistance = fromRational leg1.distance.value.getHighPrecDistance + fromRational leg2.distance.value.getHighPrecDistance
-                            },
-                        unit = leg1.distance.unit
-                      },
-                  duration = Time.Seconds $ leg1.duration.getSeconds + leg2.duration.getSeconds,
-                  polyline = GT.Polyline {encodedPolyline = encodedPolylineText},
-                  mode = MetroRail,
-                  startLocation = leg1.startLocation,
-                  endLocation = leg2.endLocation,
-                  fromStopDetails = leg1.fromStopDetails,
-                  toStopDetails = leg2.toStopDetails,
-                  routeDetails = leg1.routeDetails ++ leg2.routeDetails,
-                  agency = leg1.agency,
-                  fromArrivalTime = min <$> leg1.fromArrivalTime <*> leg2.fromArrivalTime,
-                  fromDepartureTime = min <$> leg1.fromDepartureTime <*> leg2.fromDepartureTime,
-                  toArrivalTime = max <$> leg1.toArrivalTime <*> leg2.toArrivalTime,
-                  toDepartureTime = max <$> leg1.toDepartureTime <*> leg2.toDepartureTime,
-                  frequency = max <$> leg1.frequency <*> leg2.frequency
-                }
-         in mergeMetroLegs (mergedLeg : rest) -- Add merged leg and continue
-      | otherwise = leg1 : mergeMetroLegs (leg2 : rest) -- Keep leg1, process the rest
+    getLegDistance :: MultiModalLeg -> Double
+    getLegDistance leg = fromRational $ leg.distance.value.getHighPrecDistance
+
+    -- -- Merge consecutive MetroRail legs in a route
+    -- mergeConsecutiveMetroLegs :: MultiModalRoute -> MultiModalRoute
+    -- mergeConsecutiveMetroLegs route =
+    --   let mergedLegs = mergeMetroLegs route.legs
+    --    in route {legs = mergedLegs}
+
+    -- -- Recursive function to merge consecutive MetroRail legs
+    -- mergeMetroLegs :: [MultiModalLeg] -> [MultiModalLeg]
+    -- mergeMetroLegs [] = []
+    -- mergeMetroLegs [leg] = [leg] -- Single leg, no merging needed
+    -- mergeMetroLegs (leg1 : leg2 : rest)
+    --   | leg1.mode == MetroRail && leg2.mode == MetroRail && leg1.agency == leg2.agency =
+    --     let leg1Start = leg1.startLocation
+    --         leg2Start = leg2.startLocation
+    --         leg2End = leg2.endLocation
+    --         encodedPolylineText = encode [leg1Start.latLng, leg2Start.latLng, leg2End.latLng]
+    --         mergedLeg =
+    --           MultiModalLeg
+    --             { distance =
+    --                 Distance.Distance
+    --                   { value =
+    --                       Distance.HighPrecDistance
+    --                         { getHighPrecDistance = fromRational leg1.distance.value.getHighPrecDistance + fromRational leg2.distance.value.getHighPrecDistance
+    --                         },
+    --                     unit = leg1.distance.unit
+    --                   },
+    --               duration = Time.Seconds $ leg1.duration.getSeconds + leg2.duration.getSeconds,
+    --               polyline = GT.Polyline {encodedPolyline = encodedPolylineText},
+    --               mode = MetroRail,
+    --               startLocation = leg1.startLocation,
+    --               endLocation = leg2.endLocation,
+    --               fromStopDetails = leg1.fromStopDetails,
+    --               toStopDetails = leg2.toStopDetails,
+    --               routeDetails = leg1.routeDetails ++ leg2.routeDetails,
+    --               agency = leg1.agency,
+    --               fromArrivalTime = min <$> leg1.fromArrivalTime <*> leg2.fromArrivalTime,
+    --               fromDepartureTime = min <$> leg1.fromDepartureTime <*> leg2.fromDepartureTime,
+    --               toArrivalTime = max <$> leg1.toArrivalTime <*> leg2.toArrivalTime,
+    --               toDepartureTime = max <$> leg1.toDepartureTime <*> leg2.toDepartureTime
+    --             }
+    --      in mergeMetroLegs (mergedLeg : rest) -- Add merged leg and continue
+    --   | otherwise = leg1 : mergeMetroLegs (leg2 : rest) -- Keep leg1, process the rest
     accumulateItineraries :: Maybe OTP.OTPPlanPlanItineraries -> ([MultiModalRoute], HM.HashMap T.Text [UTCTime]) -> ([MultiModalRoute], HM.HashMap T.Text [UTCTime])
     accumulateItineraries itinerary (genericRoutes, freqMap) =
       case itinerary of
@@ -340,11 +347,13 @@ convertOTPToGeneric otpResponse =
               toDepartureTime' = Just $ millisecondsToUTC $ round otpLeg'.to.departureTime
               routeDetails = case otpLeg'.route of
                 Just route ->
-                  [ MultiModalRouteDetails
+                  Just
+                    MultiModalRouteDetails
                       { gtfsId = Just $ T.pack route.gtfsId,
                         longName = fmap T.pack route.longName,
                         shortName = fmap T.pack route.shortName,
-                        color = fmap T.pack route.color
+                        color = fmap T.pack route.color,
+                        frequency = Nothing
                       }
                 Nothing -> Nothing
               (fromStopCode, fromStopGtfsId, fromStopPlatformCode) = case otpLeg'.from.stop of
@@ -388,7 +397,7 @@ convertOTPToGeneric otpResponse =
               newFreqMap = case (maybeLongName, fromArrivalTime') of
                 (Just longName, Just time) ->
                   let key = T.pack longName
-                   in HM.insertWith (++) key [time] updatedFreqMap
+                   in HM.insertWith (\new old -> nub (new ++ old)) key [time] updatedFreqMap
                 _ -> updatedFreqMap
 
               leg =
@@ -430,35 +439,45 @@ convertOTPToGeneric otpResponse =
                     fromArrivalTime = fromArrivalTime',
                     fromDepartureTime = fromDepartureTime',
                     toArrivalTime = toArrivalTime',
-                    toDepartureTime = toDepartureTime',
-                    frequency = Nothing
+                    toDepartureTime = toDepartureTime'
                   }
            in (leg : genericLegs, genericDistance + distance, newFreqMap)
 
     -- Update frequency of each leg in a route using the frequencyMap
     updateRouteFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalRoute -> MultiModalRoute
     updateRouteFrequency freqMap route =
-      let updatedLegs = map (updateLegFrequency freqMap) route.legs
+      let updatedLegs = map updateLegFrequency route.legs
        in route {legs = updatedLegs}
+      where
+        updateLegFrequency :: MultiModalLeg -> MultiModalLeg
+        updateLegFrequency leg =
+          --let updatedRouteDetails = map (updateDetailsFrequency freqMap) (routeDetails leg)
+          let updatedRouteDetails = updateDetailsFrequency freqMap <$> leg.routeDetails
+           in leg {routeDetails = updatedRouteDetails}
 
-    -- Update frequency for a single leg
-    updateLegFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalLeg -> MultiModalLeg
-    updateLegFrequency freqMap leg =
-      case listToMaybe $ mapMaybe longName (routeDetails leg) of --case routeDetails leg >>= longName of
-        Just longNameText ->
-          let key = longNameText
-              timestamps = sort $ HM.lookupDefault [] key freqMap
-              frequency = case timestamps of
-                (t1 : t2 : _) -> Just $ Time.Seconds $ round $ diffUTCTime t2 t1
-                _ -> Nothing
-           in leg {frequency = frequency}
-        Nothing -> leg
+        updateDetailsFrequency :: HM.HashMap T.Text [UTCTime] -> MultiModalRouteDetails -> MultiModalRouteDetails
+        updateDetailsFrequency frequencyMap details =
+          case longName details of
+            Just longName ->
+              let key = longName
+                  timestamps = sort $ HM.lookupDefault [] key frequencyMap
+                  frequency = case timestamps of
+                    (t1 : t2 : _) -> Just $ Time.Seconds $ round $ diffUTCTime t2 t1
+                    _ -> Nothing
+               in details {frequency = frequency}
+            Nothing -> details
 
     -- Function to get the sequence combination for a route
     getSequenceCombination :: MultiModalRoute -> T.Text
     getSequenceCombination route =
-      let sequenceCombination = mapMaybe (listToMaybe . mapMaybe longName . routeDetails) (route.legs)
+      let sequenceCombination = mapMaybe getLongNameFromLeg (route.legs)
        in T.intercalate "-" sequenceCombination
+      where
+        getLongNameFromLeg :: MultiModalLeg -> Maybe T.Text
+        getLongNameFromLeg leg =
+          case routeDetails leg of
+            Just details -> longName details
+            Nothing -> Nothing
 
     -- Function to filter routes with unique sequence combinations
     uniqueRoutes :: [MultiModalRoute] -> [MultiModalRoute]