Read far-out in gap-point, #493.

lang-haskell/app-serve/src/ServeMain.hs

@@ -86,7 +86,7 @@ import Flight.Scribe
     , readMaskingReach
     , readMaskingSpeed
     , readBonusReach
-    , readLanding, readPointing
+    , readLanding, readFaring, readPointing
     , readPilotDiscardFurther
     )
 import Flight.Cmd.Paths (LenientFile(..), checkPaths)
@@ -120,6 +120,7 @@ import Flight.Comp
     , MaskSpeedFile(..)
     , BonusReachFile(..)
     , LandOutFile(..)
+    , FarOutFile(..)
     , GapPointFile(..)
     , NormArrivalFile(..)
     , NormLandoutFile(..)
@@ -141,6 +142,7 @@ import Flight.Comp
     , compToMaskSpeed
     , compToBonusReach
     , compToLand
+    , compToFar
     , compToPoint
     , crossToTag
     , tagToPeg
@@ -291,7 +293,8 @@ go CmdServeOptions{..} compFile@(CompInputFile compPath) = do
     let maskReachFile@(MaskReachFile maskReachPath) = compToMaskReach compFile
     let maskSpeedFile@(MaskSpeedFile maskSpeedPath) = compToMaskSpeed compFile
     let bonusReachFile@(BonusReachFile bonusReachPath) = compToBonusReach compFile
-    let landFile@(LandOutFile landPath) = compToLand compFile
+    let landFile@(LandOutFile _landPath) = compToLand compFile
+    let farFile@(FarOutFile landPath) = compToFar compFile
     let pointFile@(GapPointFile pointPath) = compToPoint compFile
     let normArrivalFile@(NormArrivalFile normArrivalPath) = compToNormArrival compFile
     let normLandoutFile@(NormLandoutFile normLandoutPath) = compToNormLandout compFile
@@ -380,11 +383,16 @@ go CmdServeOptions{..} compFile@(CompInputFile compPath) = do
                     (Just <$> readMaskingSpeed maskSpeedFile)
                     (const $ return Nothing)
 
-            landing <-
+            _landing <-
                 catchIO
                     (Just <$> readLanding landFile)
                     (const $ return Nothing)
 
+            landing <-
+                catchIO
+                    (Just <$> readFaring farFile)
+                    (const $ return Nothing)
+
             pointing <-
                 catchIO
                     (Just <$> readPointing pointFile)

lang-haskell/flare-timing/flare-timing.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 13e47101cd25bda529fbd1eb4150963041b7af57584c6bc5a4011577c81d029e
+-- hash: 2a6e68da54a282e5ca53945f0777a74ac3a4585ba6d5460140b02f5e9edd726d
 
 name:           flare-timing
 version:        0.1.0
@@ -428,9 +428,12 @@ executable ft-extract-input
 executable ft-far-out
   main-is: FarOutMain.hs
   other-modules:
+      MaskPilots
+      Stats
       FarOutOptions
-      Paths_flare_timing
   hs-source-dirs:
+      prod-apps/mask-common
+      prod-apps/mask-effort
       prod-apps/far-out
   default-extensions: DataKinds DeriveFunctor DeriveGeneric DeriveAnyClass DerivingStrategies DisambiguateRecordFields FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving GADTs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns OverloadedStrings PackageImports ParallelListComp PartialTypeSignatures PatternSynonyms QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TypeApplications TypeFamilies TypeOperators TypeSynonymInstances TupleSections UndecidableInstances
   ghc-options: -Wall -Werror -Wincomplete-uni-patterns -Wcompat -Widentities -Wredundant-constraints -fhide-source-paths -rtsopts -threaded -with-rtsopts=-N -Wall -fplugin Data.UnitsOfMeasure.Plugin
@@ -447,13 +450,17 @@ executable ft-far-out
     , flight-comp
     , flight-gap-allot
     , flight-gap-effort
+    , flight-gap-valid
     , flight-latlng
+    , flight-lookup
+    , flight-route
     , flight-scribe
     , flight-time
     , formatting
     , mtl
     , raw-strings-qq
     , safe-exceptions
+    , time
     , transformers
     , uom-plugin
     , yaml

lang-haskell/flare-timing/package.dhall

@@ -613,9 +613,15 @@ in    defs
               { dependencies =
                     deps
                   # [ "safe-exceptions"
+                    , "time"
+                    , "flight-lookup"
+                    , "flight-route"
                     , "flight-gap-allot"
                     , "flight-gap-effort"
+                    , "flight-gap-valid"
                     ]
+              , other-modules =
+                  [ "MaskPilots", "Stats", "FarOutOptions" ]
               , ghc-options =
                   [ "-rtsopts"
                   , "-threaded"
@@ -626,7 +632,10 @@ in    defs
               , main =
                   "FarOutMain.hs"
               , source-dirs =
-                  "prod-apps/far-out"
+                  [ "prod-apps/mask-common"
+                  , "prod-apps/mask-effort"
+                  , "prod-apps/far-out"
+                  ]
               }
           , ft-gap-point =
               { dependencies =

lang-haskell/flare-timing/prod-apps/far-out/FarOutMain.hs

@@ -5,6 +5,7 @@ import System.Console.CmdArgs.Implicit (cmdArgs)
 import Formatting ((%), fprint)
 import Formatting.Clock (timeSpecs)
 import System.Clock (getTime, Clock(Monotonic))
+import Data.Maybe (catMaybes)
 import Control.Monad (mapM_)
 import Control.Monad.Zip (munzip)
 import Control.Exception.Safe (catchIO)
@@ -13,32 +14,43 @@ import System.Directory (getCurrentDirectory)
 import Data.UnitsOfMeasure (u)
 import Data.UnitsOfMeasure.Internal (Quantity(..))
 
+import Flight.Route (OptimalRoute(..))
+import qualified Flight.Comp as Cmp (Nominal(..))
 import Flight.Cmd.Paths (LenientFile(..), checkPaths)
 import Flight.Cmd.Options (ProgramName(..))
 import Flight.Cmd.BatchOptions (CmdBatchOptions(..), mkOptions)
 import Flight.Comp
     ( FindDirFile(..)
     , FileType(CompInput)
     , CompInputFile(..)
+    , TaskLengthFile(..)
     , CompSettings(..)
     , Nominal(..)
-    , MaskEffortFile(..)
-    , compToMaskEffort
+    , MaskReachFile(..)
+    , PilotGroup(didFlyNoTracklog)
+    , IxTask(..)
+    , compToTaskLength
+    , compToMaskReach
     , compToFar
     , findCompInput
     , ensureExt
     )
-import Flight.Distance (unTaskDistanceAsKm)
-import Flight.Track.Distance (TrackDistance(..))
-import Flight.Track.Mask (MaskingEffort(..))
+import Flight.Distance (unTaskDistanceAsKm, fromKms)
+import Flight.Track.Distance (TrackDistance(..), Effort)
+import Flight.Track.Mask (MaskingEffort(..), MaskingReach(..))
 import qualified Flight.Track.Land as Cmp (Landing(..))
-import Flight.Scribe (readComp, readMaskingEffort, writeFaring)
+import qualified Flight.Lookup as Lookup (compRoutes)
+import Flight.Scribe (readComp, readRoute, readMaskingReach, writeFaring)
 import "flight-gap-allot" Flight.Score
     (FlownMax(..), PilotDistance(..), MinimumDistance(..), Pilot)
 import "flight-gap-effort" Flight.Score (Difficulty(..), mergeChunks)
 import qualified "flight-gap-effort" Flight.Score as Gap
     (Chunking(..), ChunkDifficulty(..), landouts, lookahead, gradeDifficulty)
+import "flight-gap-valid" Flight.Score (ReachStats(..))
+import Flight.Lookup.Route (routeLength)
 import FarOutOptions (description)
+import MaskPilots (didFlyNoTrackStats)
+import Stats (FlightStats(..))
 
 main :: IO ()
 main = do
@@ -62,10 +74,13 @@ drive o@CmdBatchOptions{file} = do
     fprint ("Far outs counted for distance difficulty completed in " % timeSpecs % "\n") start end
 
 go :: CmdBatchOptions -> CompInputFile -> IO ()
-go CmdBatchOptions{..} compFile = do
-    let maskFile@(MaskEffortFile maskPath) = compToMaskEffort compFile
+go CmdBatchOptions{..} compFile@(CompInputFile compPath) = do
+    let lenFile@(TaskLengthFile lenPath) = compToTaskLength compFile
+    let maskReachFile@(MaskReachFile maskReachPath) = compToMaskReach compFile
     let farFile = compToFar compFile
-    putStrLn $ "Reading far outs from '" ++ takeFileName maskPath ++ "'"
+    putStrLn $ "Reading competition from '" ++ takeFileName compPath ++ "'"
+    putStrLn $ "Reading task length from '" ++ takeFileName lenPath ++ "'"
+    putStrLn $ "Reading far outs from '" ++ takeFileName maskReachPath ++ "'"
 
     compSettings <-
         catchIO
@@ -74,13 +89,75 @@ go CmdBatchOptions{..} compFile = do
 
     masking <-
         catchIO
-            (Just <$> readMaskingEffort maskFile)
+            (Just <$> readMaskingReach maskReachFile)
             (const $ return Nothing)
 
-    case (compSettings, masking) of
-        (Nothing, _) -> putStrLn "Couldn't read the comp settings."
-        (_, Nothing) -> putStrLn "Couldn't read the maskings."
-        (Just cs, Just mk) -> writeFaring farFile $ difficulty cs mk
+    routes <-
+        catchIO
+            (Just <$> readRoute lenFile)
+            (const $ return Nothing)
+
+    let lookupTaskLength =
+            routeLength
+                taskRoute
+                taskRouteSpeedSubset
+                stopRoute
+                startRoute
+                routes
+
+    case (compSettings, masking, routes) of
+        (Nothing, _, _) -> putStrLn "Couldn't read the comp settings."
+        (_, Nothing, _) -> putStrLn "Couldn't read the routes."
+        (_, _, Nothing) -> putStrLn "Couldn't read the maskings."
+        (Just cs, Just mk, Just _) -> do
+            let CompSettings{nominal = Cmp.Nominal{free}, tasks, pilotGroups} = cs
+            let ixTasks = take (length tasks) (IxTask <$> [1 ..])
+
+            let dfNtss =
+                    didFlyNoTrackStats
+                        free
+                        tasks
+                        (Lookup.compRoutes lookupTaskLength ixTasks)
+                        (didFlyNoTracklog <$> pilotGroups)
+
+            let ess =
+                    [
+                        catMaybes
+                        [ (p,) <$> statEffort
+                        | (p, FlightStats{statEffort}) <- dfNts
+                        ]
+
+                    | dfNts <- dfNtss
+                    ]
+
+            writeFaring farFile $ difficultyByReach cs mk ess
+
+difficultyByReach
+    :: CompSettings k
+    -> MaskingReach
+    -> [[(Pilot, TrackDistance Effort)]]
+    -> Cmp.Landing
+difficultyByReach cs MaskingReach{bolster, nigh} dfNtss =
+    difficulty
+        cs
+        MaskingEffort
+            { bestEffort =
+                [ do
+                    ReachStats{max = FlownMax d} <- b
+                    return $ fromKms d
+
+                | b <- bolster
+                ]
+            , land = zipWith (++) xss dfNtss
+            }
+    where
+        xss =
+                [
+                    [ (p,) . (\x -> TrackDistance Nothing x) $ made
+                    | (p, TrackDistance{made}) <- ns
+                    ]
+                | ns <- nigh
+                ]
 
 difficulty :: CompSettings k -> MaskingEffort -> Cmp.Landing
 difficulty CompSettings{nominal} MaskingEffort{bestEffort, land} =

lang-haskell/flare-timing/prod-apps/gap-point/GapPointMain.hs

@@ -57,6 +57,7 @@ import Flight.Comp
     , MaskSpeedFile(..)
     , BonusReachFile(..)
     , LandOutFile(..)
+    , FarOutFile(..)
     , Pilot
     , PilotGroup(dnf, didFlyNoTracklog)
     , StartGate(..)
@@ -79,6 +80,7 @@ import Flight.Comp
     , compToMaskSpeed
     , compToBonusReach
     , compToLand
+    , compToFar
     , compToPoint
     , findCompInput
     , ensureExt
@@ -116,6 +118,7 @@ import Flight.Scribe
     , readMaskingSpeed
     , readBonusReach
     , readLanding
+    , readFaring
     , writePointing
     )
 import Flight.Mask (RaceSections(..), section)
@@ -206,7 +209,8 @@ go CmdBatchOptions{..} compFile@(CompInputFile compPath) = do
     let maskReachFile@(MaskReachFile maskReachPath) = compToMaskReach compFile
     let maskSpeedFile@(MaskSpeedFile maskSpeedPath) = compToMaskSpeed compFile
     let bonusReachFile@(BonusReachFile bonusReachPath) = compToBonusReach compFile
-    let landFile@(LandOutFile landPath) = compToLand compFile
+    let landFile@(LandOutFile _landPath) = compToLand compFile
+    let farFile@(FarOutFile landPath) = compToFar compFile
     let pointFile = compToPoint compFile
     putStrLn $ "Reading task length from '" ++ takeFileName lenPath ++ "'"
     putStrLn $ "Reading pilots ABS & DNF from task from '" ++ takeFileName compPath ++ "'"
@@ -271,11 +275,16 @@ go CmdBatchOptions{..} compFile@(CompInputFile compPath) = do
             (Just <$> readMaskingSpeed maskSpeedFile)
             (const $ return Nothing)
 
-    landing <-
+    _landing <-
         catchIO
             (Just <$> readLanding landFile)
             (const $ return Nothing)
 
+    landing <-
+        catchIO
+            (Just <$> readFaring farFile)
+            (const $ return Nothing)
+
     routes <-
         catchIO
             (Just <$> readRoute lenFile)