Interactive work report

nix/overlay.nix

@@ -135,7 +135,7 @@ in
                 smosPkg = name: buildStrictly (ownPkg name (../. + "/${name}"));
                 smosPkgWithComp = exeName: name: self.generateOptparseApplicativeCompletions [ exeName ] (smosPkg name);
                 smosPkgWithOwnComp = name: smosPkgWithComp name name;
-                withTZData = pkg: (overrideCabal pkg) (old: {
+                withTZTestData = pkg: (overrideCabal pkg) (old: {
                   testDepends = (old.testDepends or [ ]) ++ [
                     final.tzdata
                   ];
@@ -279,7 +279,7 @@ in
                     sha256 = "sha256:0cm7wj49qmbi9kp5hs3wc6vcr1h0d5h864pa5bc401nm5kppp958";
                   };
                 } // mapAttrs' (name: value: nameValuePair "casts/${name}.cast" value) final.smosCasts);
-                smos = overrideCabal (smosPkgWithOwnComp "smos") (
+                smos = overrideCabal (withTZTestData (smosPkgWithOwnComp "smos")) (
                   old: {
                     postBuild = ''
                       ${old.postBuild or ""}
@@ -306,9 +306,9 @@ in
                 "smos-report-gen" = smosPkg "smos-report-gen";
                 "smos-report-cursor" = smosPkg "smos-report-cursor";
                 "smos-report-cursor-gen" = smosPkg "smos-report-cursor-gen";
-                "smos-query" = withTZData (smosPkgWithOwnComp "smos-query");
+                "smos-query" = withTZTestData (smosPkgWithOwnComp "smos-query");
                 "smos-single" = smosPkgWithOwnComp "smos-single";
-                "smos-scheduler" = withTZData (smosPkgWithOwnComp "smos-scheduler");
+                "smos-scheduler" = withTZTestData (smosPkgWithOwnComp "smos-scheduler");
                 "smos-archive" = smosPkgWithOwnComp "smos-archive";
                 "smos-calendar-import" = smosPkgWithOwnComp "smos-calendar-import";
                 "smos-api" = smosPkg "smos-api";

smos-cursor/default.nix

@@ -1,7 +1,7 @@
 { mkDerivation, base, containers, cursor, cursor-dirforest
 , cursor-fuzzy-time, deepseq, dirforest, exceptions, filelock
 , fuzzy-time, lib, microlens, path, path-io, resourcet
-, smos-archive, smos-data, text, time, validity, validity-time
+, smos-archive, smos-data, text, time, tz, validity, validity-time
 }:
 mkDerivation {
   pname = "smos-cursor";
@@ -10,7 +10,8 @@ mkDerivation {
   libraryHaskellDepends = [
     base containers cursor cursor-dirforest cursor-fuzzy-time deepseq
     dirforest exceptions filelock fuzzy-time microlens path path-io
-    resourcet smos-archive smos-data text time validity validity-time
+    resourcet smos-archive smos-data text time tz validity
+    validity-time
   ];
   homepage = "https://github.com/NorfairKing/smos#readme";
   license = "unknown";

smos-cursor/package.yaml

@@ -25,5 +25,6 @@ library:
   - smos-data
   - text
   - time
+  - tz
   - validity
   - validity-time

smos-cursor/smos-cursor.cabal

@@ -56,6 +56,7 @@ library
     , smos-data
     , text
     , time
+    , tz
     , validity
     , validity-time
   default-language: Haskell2010

smos-cursor/src/Smos/Cursor/Entry.hs

@@ -35,6 +35,7 @@ import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Time
+import Data.Time.Zones
 import Data.Validity
 import GHC.Generics (Generic)
 import Lens.Micro
@@ -179,5 +180,5 @@ instance Validity EntryCursorSelection
 
 instance NFData EntryCursorSelection
 
-entryCursorUpdateTime :: ZonedTime -> EntryCursor -> EntryCursor
+entryCursorUpdateTime :: TZ -> UTCTime -> EntryCursor -> EntryCursor
-entryCursorUpdateTime zt = entryCursorTimestampsCursorL %~ fmap (timestampsCursorUpdateTime zt)
+entryCursorUpdateTime zone now = entryCursorTimestampsCursorL %~ fmap (timestampsCursorUpdateTime zone now)

smos-cursor/src/Smos/Cursor/SmosFile.hs

@@ -64,6 +64,7 @@ import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Time
+import Data.Time.Zones
 import Data.Validity
 import GHC.Generics (Generic)
 import Lens.Micro
@@ -363,8 +364,8 @@ smosFileCursorClockOutEverywhereAndClockInHere now sfc =
           %~ (\lbc -> fromMaybe lbc $ logbookCursorClockIn now lbc)
         & (smosFileCursorSelectedCollapseEntryL . collapseEntryShowLogbookL .~ True)
 
-smosFileCursorUpdateTime :: ZonedTime -> SmosFileCursor -> SmosFileCursor
+smosFileCursorUpdateTime :: TZ -> UTCTime -> SmosFileCursor -> SmosFileCursor
-smosFileCursorUpdateTime zt = smosFileCursorSelectedEntryL %~ entryCursorUpdateTime zt
+smosFileCursorUpdateTime zone now = smosFileCursorSelectedEntryL %~ entryCursorUpdateTime zone now
 
 smosFileSubtreeSetTodoState :: UTCTime -> Maybe TodoState -> SmosFileCursor -> SmosFileCursor
 smosFileSubtreeSetTodoState now mts = smosFileCursorForestCursorL . forestCursorSelectedTreeL . treeCursorCurrentSubTreeL %~ go

smos-cursor/src/Smos/Cursor/SmosFileEditor.hs

@@ -10,6 +10,7 @@ import Data.Function
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Time
+import Data.Time.Zones
 import GHC.Generics (Generic)
 import Lens.Micro
 import Path
@@ -139,5 +140,5 @@ smosFileEditorCursorHistoryL = lens smosFileEditorCursorHistory $ \sfec h -> sfe
 smosFileEditorCursorPresent :: SmosFileEditorCursor -> Maybe SmosFileCursor
 smosFileEditorCursorPresent = historyPresent . smosFileEditorCursorHistory
 
-smosFileEditorCursorUpdateTime :: ZonedTime -> SmosFileEditorCursor -> SmosFileEditorCursor
+smosFileEditorCursorUpdateTime :: TZ -> UTCTime -> SmosFileEditorCursor -> SmosFileEditorCursor
-smosFileEditorCursorUpdateTime zt = smosFileEditorCursorHistoryL . historyPresentL %~ fmap (smosFileCursorUpdateTime zt)
+smosFileEditorCursorUpdateTime zone now = smosFileEditorCursorHistoryL . historyPresentL %~ fmap (smosFileCursorUpdateTime zone now)

smos-cursor/src/Smos/Cursor/Timestamps.hs

@@ -40,6 +40,7 @@ import Data.Map (Map)
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Time
+import Data.Time.Zones
 import Data.Validity
 import GHC.Generics (Generic)
 import Lens.Micro
@@ -194,8 +195,8 @@ timestampsCursorSelectOrAdd tsn lt =
         (\t _ -> t == tsn)
         (makeKeyValueCursorValue tsn (emptyFuzzyLocalTimeCursor (mkImpreciseLocalTime lt)))
 
-timestampsCursorUpdateTime :: ZonedTime -> TimestampsCursor -> TimestampsCursor
+timestampsCursorUpdateTime :: TZ -> UTCTime -> TimestampsCursor -> TimestampsCursor
-timestampsCursorUpdateTime zt = (timestampsCursorMapCursorL . mapCursorElemL) %~ go
+timestampsCursorUpdateTime zone now = (timestampsCursorMapCursorL . mapCursorElemL) %~ go
   where
     go ::
       KeyValueCursor TextCursor FuzzyLocalTimeCursor TimestampName Timestamp ->
@@ -204,11 +205,7 @@ timestampsCursorUpdateTime zt = (timestampsCursorMapCursorL . mapCursorElemL) %~
       case kvc of
         KeyValueCursorKey _ _ -> kvc
         KeyValueCursorValue k fztc ->
-          KeyValueCursorValue k $
+          KeyValueCursorValue k $ fztc {fuzzyLocalTimeCursorBaseLocalTime = mkImpreciseLocalTime $ utcToLocalTimeTZ zone now}
-            fztc
-              { fuzzyLocalTimeCursorBaseLocalTime =
-                  mkImpreciseLocalTime $ utcToLocalTime (zonedTimeZone zt) (zonedTimeToUTC zt)
-              }
 
 -- safe because of validity
 makeTimestampNameCursor :: TimestampName -> TextCursor

smos-docs-site/content/casts/archive.yaml

@@ -4,6 +4,7 @@ packages:
 - smos-query
 - smos
 - smos-archive
+- tzdata
 environment:
   SMOS_WORKFLOW_DIR: .
   SMOS_EXPLAINER_MODE: 'True'

smos-docs-site/content/casts/basics.yaml

@@ -1,6 +1,7 @@
 working-dir: ../../demo-workflow
 packages:
 - smos
+- tzdata
 environment:
   SMOS_WORKFLOW_DIR: .
   SMOS_EXPLAINER_MODE: 'True'

smos-docs-site/content/casts/browser.yaml

@@ -1,6 +1,7 @@
 working-dir: ../../demo-workflow
 packages:
 - smos
+- tzdata
 environment:
   SMOS_WORKFLOW_DIR: .
   SMOS_EXPLAINERV_MODE: 'True'

smos-docs-site/content/casts/example.yaml

@@ -1,6 +1,7 @@
 command: smos example.smos
 packages:
 - smos
+- tzdata
 file: example.smos
 rows: 25
 columns: 80

smos-docs-site/content/casts/next.yaml

@@ -6,6 +6,7 @@ environment:
 packages:
 - smos-query
 - smos
+- tzdata
 input:
 - type: "smos-query next\n"
 - wait: 2000

smos-docs-site/content/casts/waiting.yaml

@@ -3,6 +3,7 @@ file: projects/interviews/cs-syd.smos
 packages:
 - smos-query
 - smos
+- tzdata
 environment:
   SMOS_WORKFLOW_DIR: .
   SMOS_EXPLAINER_MODE: 'True'

smos-docs-site/content/pages/smos-query/ongoing.markdown

@@ -0,0 +1,8 @@
+---
+title: Ongoing
+description: Documentation about the smos-query ongoing command, for a report of which entries are currently ongoing.
+---
+
+The ongoing report shows you all of the entries that are ongoing.
+
+I.e. the entries for which the current time is between their `BEGIN` and `END` timestamps.

smos-docs-site/content/unreleased.markdown

@@ -11,6 +11,7 @@
 * `smos-server`: Booking API: Users can now activate booking and be booked.
 * `smos-web-server`: Booking UI: Users can now activate booking and be booked.
 * `smos-api` and `smos-client`: An endpoint for deleting smos files.
+* `smos-query`: The `ongoing` command: For showing entries that are happening now.
 
 ### Changed
 
@@ -29,3 +30,6 @@
 * All packages: Upgraded to LTS 20.23 and nixpkgs branch `nixos-23.05`.
 * `smos-web-server`: Empty directories are now deleted in the web editor.
 * `smos-notify`: The notification now shows the filename of the entry that the notification is about.
+* `smos`: Fixed a bug where the cursor would sometimes become invisible in the work report.
+* `smos-query`: Added an `ongoing` section to the work report.
+* `smos`: Added an `ongoing` section to the interactive work report.

smos-docs-site/smos-docs-site.cabal

@@ -98,6 +98,7 @@ extra-source-files:
     content/pages/smos-query/free.markdown
     content/pages/smos-query/log.markdown
     content/pages/smos-query/next.markdown
+    content/pages/smos-query/ongoing.markdown
     content/pages/smos-query/projects.markdown
     content/pages/smos-query/report.markdown
     content/pages/smos-query/sorter.markdown

smos-docs-site/src/Smos/Docs/Site/Handler/Keybindings.hs

@@ -19,9 +19,10 @@ getSmosKeybindingsR = do
   let KeyMap _ _ _ _ _ = undefined
       FileKeyMap _ _ _ _ _ _ _ _ _ _ = undefined
       BrowserKeyMap _ _ _ _ _ = undefined
-      ReportsKeyMap _ _ _ _ _ _ = undefined
+      ReportsKeyMap _ _ _ _ _ _ _ = undefined
       NextActionReportKeyMap _ _ _ = undefined
       WaitingReportKeyMap _ _ _ = undefined
+      OngoingReportKeyMap _ _ _ = undefined
       TimestampsReportKeyMap _ _ _ = undefined
       StuckReportKeyMap _ _ = undefined
       HelpKeyMap _ _ _ = undefined

smos-docs-site/templates/menu.hamlet

@@ -96,6 +96,9 @@
         <li>
           <a href=@{SmosQueryCommandR "waiting"}>
             Waiting report
+        <li>
+          <a href=@{SmosQueryCommandR "ongoing"}>
+            Ongoing report
         <li>
           <a href=@{SmosQueryCommandR "clock"}>
             Clock report

smos-docs-site/templates/smos-keybindings.hamlet

@@ -117,6 +117,18 @@
     Any
   ^{keyMapTable $ waitingReportAnyMatchers $ reportsKeymapWaitingReportKeyMap $ keyMapReportsKeyMap defaultKeyMap }
 
+  <h3>
+    Ongoing Report
+  <h4>
+    Normal
+  ^{keyMapTable $ ongoingReportMatchers $ reportsKeymapOngoingReportKeyMap $ keyMapReportsKeyMap defaultKeyMap }
+  <h4>
+    Search
+  ^{keyMapTable $ ongoingReportSearchMatchers $ reportsKeymapOngoingReportKeyMap $ keyMapReportsKeyMap defaultKeyMap }
+  <h4>
+    Any
+  ^{keyMapTable $ ongoingReportAnyMatchers $ reportsKeymapOngoingReportKeyMap $ keyMapReportsKeyMap defaultKeyMap }
+
   <h3>
     Agenda Report
   <h4>

smos-query/smos-query.cabal

@@ -24,6 +24,7 @@ library
       Smos.Query.Commands.Import
       Smos.Query.Commands.Log
       Smos.Query.Commands.Next
+      Smos.Query.Commands.Ongoing
       Smos.Query.Commands.PreparedReport
       Smos.Query.Commands.Projects
       Smos.Query.Commands.Stats
@@ -90,6 +91,7 @@ test-suite smos-query-test
       Smos.Query.AgendaSpec
       Smos.Query.FreeSpec
       Smos.Query.NextSpec
+      Smos.Query.OngoingSpec
       Smos.Query.TestUtils
       Smos.Query.WaitingSpec
       Smos.Query.WorkSpec

smos-query/src/Smos/Query.hs

@@ -36,6 +36,7 @@ execute = \case
   DispatchPreparedReport es -> smosQueryPreparedReport es
   DispatchWaiting ws -> smosQueryWaiting ws
   DispatchNext ns -> smosQueryNext ns
+  DispatchOngoing ns -> smosQueryOngoing ns
   DispatchClock cs -> smosQueryClock cs
   DispatchAgenda as -> smosQueryAgenda as
   DispatchProjects ps -> smosQueryProjects ps

smos-query/src/Smos/Query/Commands/Ongoing.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Smos.Query.Commands.Ongoing (smosQueryOngoing) where
+
+import Conduit
+import Smos.Query.Commands.Import
+import Smos.Report.Ongoing
+
+smosQueryOngoing :: OngoingSettings -> Q ()
+smosQueryOngoing OngoingSettings {..} = do
+  dc <- asks envDirectorySettings
+  sp <- getShouldPrint
+  zone <- liftIO loadLocalTZ
+  now <- liftIO getCurrentTime
+  report <- liftIO $ produceOngoingReport zone now ongoingSetFilter ongoingSetHideArchive sp dc
+
+  colourSettings <- asks envColourSettings
+  outputChunks $ renderOngoingReport zone now colourSettings report
+
+renderOngoingReport :: TZ -> UTCTime -> ColourSettings -> OngoingReport -> [Chunk]
+renderOngoingReport zone now colourSettings =
+  formatAsBicolourTable colourSettings
+    . map (formatOngoingEntry zone now)
+    . ongoingReportEntries

smos-query/src/Smos/Query/Commands/Work.hs

@@ -1,10 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
-module Smos.Query.Commands.Work
+module Smos.Query.Commands.Work (smosQueryWork) where
-  ( smosQueryWork,
-  )
-where
 
 import Conduit
 import qualified Data.Map as M
@@ -81,9 +78,14 @@ renderWorkReport cc zone now ctxs waitingThreshold stuckThreshold ne WorkReport
                   \(f, violations) ->
                     unlessNull violations [warningHeading ("Check violation for " <> renderFilter f), [entryTable violations]]
               ),
+            unlessNull
+              workReportOngoingEntries
+              [ sectionHeading "Ongoing",
+                [ongoingTable]
+              ],
             unlessNull
               workReportAgendaEntries
-              [ sectionHeading "Deadlines",
+              [ sectionHeading "Upcoming",
                 [agendaTable]
               ],
             unlessNull
@@ -118,6 +120,7 @@ renderWorkReport cc zone now ctxs waitingThreshold stuckThreshold ne WorkReport
     spacer = [formatAsBicolourTable cc [[chunk " "]]]
     entryTable = renderEntryReport cc . makeEntryReport ne
     agendaTable = formatAsBicolourTable cc $ map (formatAgendaEntry zone now) workReportAgendaEntries
+    ongoingTable = formatAsBicolourTable cc $ map (formatOngoingEntry zone now) workReportOngoingEntries
     waitingTable = formatAsBicolourTable cc $ map (formatWaitingEntry waitingThreshold now) workReportOverdueWaiting
     stuckTable = formatAsBicolourTable cc $ map (formatStuckReportEntry stuckThreshold now) workReportOverdueStuck
     limboTable = formatAsBicolourTable cc $ map ((: []) . pathChunk) workReportLimboProjects

smos-query/src/Smos/Query/Formatting.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -14,6 +15,7 @@ import Smos.CLI.Formatting
 import Smos.Data
 import Smos.Report.Agenda
 import Smos.Report.Entry
+import Smos.Report.Ongoing
 import Smos.Report.Projection
 import Smos.Report.Stuck
 import Smos.Report.Time
@@ -36,25 +38,29 @@ formatAgendaEntry zone now AgendaEntry {..} =
             | d == 0 && agendaEntryTimestampName == "SCHEDULED" -> fore green
             | otherwise -> id
    in [ func $ chunk $ timestampPrettyText agendaEntryTimestamp,
-        func $
+        func $ relativeTimestampChunk zone now agendaEntryTimestamp,
-          bold $
-            chunk $
-              T.pack $
-                case agendaEntryTimestamp of
-                  TimestampDay _ ->
-                    renderDaysAgoAuto $ daysAgo d
-                  TimestampLocalTime lt ->
-                    renderTimeAgoAuto $
-                      timeAgo $
-                        diffUTCTime
-                          now
-                          (localTimeToUTCTZ zone lt),
         timestampNameChunk agendaEntryTimestampName,
         mTodoStateChunk agendaEntryTodoState,
         headerChunk agendaEntryHeader,
         func $ pathChunk agendaEntryFilePath
       ]
 
+relativeTimestampChunk :: TZ -> UTCTime -> Timestamp -> Chunk
+relativeTimestampChunk zone now =
+  bold
+    . chunk
+    . T.pack
+    . \case
+      TimestampDay d ->
+        let ds = diffDays (localDay $ utcToLocalTimeTZ zone now) d
+         in renderDaysAgoAuto $ daysAgo ds
+      TimestampLocalTime lt ->
+        renderTimeAgoAuto $
+          timeAgo $
+            diffUTCTime
+              now
+              (localTimeToUTCTZ zone lt)
+
 formatWaitingEntry :: Time -> UTCTime -> WaitingEntry -> [Chunk]
 formatWaitingEntry threshold now WaitingEntry {..} =
   [ pathChunk waitingEntryFilePath,
@@ -63,6 +69,39 @@ formatWaitingEntry threshold now WaitingEntry {..} =
     maybe (chunk "") timeChunk waitingEntryThreshold
   ]
 
+formatOngoingEntry :: TZ -> UTCTime -> OngoingEntry -> [Chunk]
+formatOngoingEntry zone now OngoingEntry {..} =
+  [ pathChunk ongoingEntryFilePath,
+    headerChunk ongoingEntryHeader
+  ]
+    ++ beginEndChunks zone now ongoingEntryBeginEnd
+
+beginEndChunks :: TZ -> UTCTime -> BeginEnd -> [Chunk]
+beginEndChunks zone now = \case
+  OnlyBegin begin ->
+    [ fore brown $ chunk $ timestampPrettyText begin,
+      fore white $ relativeTimestampChunk zone now begin,
+      "",
+      "",
+      "",
+      ""
+    ]
+  OnlyEnd end ->
+    [ "",
+      "",
+      "",
+      fore white $ relativeTimestampChunk zone now end,
+      ""
+    ]
+  BeginEnd begin end ->
+    [ fore brown $ chunk $ timestampPrettyText begin,
+      fore white $ relativeTimestampChunk zone now begin,
+      "-",
+      fore brown $ chunk $ timestampPrettyText end,
+      fore white $ relativeTimestampChunk zone now end,
+      chunk $ T.pack $ beginEndPercentageString (utcToLocalTimeTZ zone now) begin end
+    ]
+
 formatStuckReportEntry :: Time -> UTCTime -> StuckReportEntry -> [Chunk]
 formatStuckReportEntry threshold now StuckReportEntry {..} =
   [ pathChunk stuckReportEntryFilePath,

smos-query/src/Smos/Query/OptParse.hs

@@ -96,6 +96,13 @@ combineToInstructions c Flags {..} Environment {..} mc = do
               { nextSetFilter = nextFlagFilter,
                 nextSetHideArchive = hideArchiveWithDefault HideArchive nextFlagHideArchive
               }
+      CommandOngoing OngoingFlags {..} ->
+        pure $
+          DispatchOngoing
+            OngoingSettings
+              { ongoingSetFilter = ongoingFlagFilter,
+                ongoingSetHideArchive = hideArchiveWithDefault HideArchive ongoingFlagHideArchive
+              }
       CommandClock ClockFlags {..} ->
         pure $
           DispatchClock
@@ -276,6 +283,7 @@ parseCommand =
         command "report" parseCommandReport,
         command "waiting" parseCommandWaiting,
         command "next" parseCommandNext,
+        command "ongoing" parseCommandOngoing,
         command "clock" parseCommandClock,
         command "agenda" parseCommandAgenda,
         command "projects" parseCommandProjects,
@@ -420,6 +428,17 @@ parseCommandNext = info parser modifier
                 <*> Report.parseHideArchiveFlag
             )
 
+parseCommandOngoing :: ParserInfo Command
+parseCommandOngoing = info parser modifier
+  where
+    modifier = fullDesc <> progDesc "Print the ongoing entries"
+    parser =
+      CommandOngoing
+        <$> ( OngoingFlags
+                <$> Report.parseFilterArgsRel
+                <*> Report.parseHideArchiveFlag
+            )
+
 parseCommandClock :: ParserInfo Command
 parseCommandClock = info parser modifier
   where

smos-query/src/Smos/Query/OptParse/Types.hs

@@ -49,6 +49,7 @@ data Command
   | CommandPreparedReport !PreparedReportFlags
   | CommandWaiting !WaitingFlags
   | CommandNext !NextFlags
+  | CommandOngoing !OngoingFlags
   | CommandClock !ClockFlags
   | CommandAgenda !AgendaFlags
   | CommandProjects !ProjectsFlags
@@ -88,6 +89,12 @@ data NextFlags = NextFlags
   }
   deriving (Show, Eq)
 
+data OngoingFlags = OngoingFlags
+  { ongoingFlagFilter :: !(Maybe EntryFilter),
+    ongoingFlagHideArchive :: !(Maybe HideArchive)
+  }
+  deriving (Show, Eq)
+
 data ClockFlags = ClockFlags
   { clockFlagFilter :: !(Maybe EntryFilter),
     clockFlagPeriodFlags :: !(Maybe Period),
@@ -234,6 +241,7 @@ data Dispatch
   | DispatchPreparedReport !PreparedReportSettings
   | DispatchWaiting !WaitingSettings
   | DispatchNext !NextSettings
+  | DispatchOngoing !OngoingSettings
   | DispatchClock !ClockSettings
   | DispatchAgenda !AgendaSettings
   | DispatchProjects !ProjectsSettings
@@ -274,6 +282,12 @@ data NextSettings = NextSettings
   }
   deriving (Show, Eq, Generic)
 
+data OngoingSettings = OngoingSettings
+  { ongoingSetFilter :: !(Maybe EntryFilter),
+    ongoingSetHideArchive :: !HideArchive
+  }
+  deriving (Show, Eq, Generic)
+
 data ClockSettings = ClockSettings
   { clockSetFilter :: !(Maybe EntryFilter),
     clockSetPeriod :: !Period,

smos-query/test/Smos/Query/OngoingSpec.hs

@@ -0,0 +1,13 @@
+module Smos.Query.OngoingSpec (spec) where
+
+import Smos.Query.TestUtils
+import Test.Syd
+import Test.Syd.Validity
+
+spec :: Spec
+spec = sequential $
+  modifyMaxSuccess (`div` 50) $ -- The first test will be empty, the second will not
+    describe "Ongoing" $
+      it "'just works' for any InterestingStore" $
+        forAllValid $
+          \is -> testSmosQuery is ["ongoing"]

smos-report-cursor-gen/smos-report-cursor-gen.cabal

@@ -16,6 +16,7 @@ library
   exposed-modules:
       Smos.Cursor.Report.Entry.Gen
       Smos.Cursor.Report.Next.Gen
+      Smos.Cursor.Report.Ongoing.Gen
       Smos.Cursor.Report.Stuck.Gen
       Smos.Cursor.Report.Timestamps.Gen
       Smos.Cursor.Report.Waiting.Gen
@@ -48,6 +49,7 @@ test-suite smos-report-cursor-test
   other-modules:
       Smos.Cursor.Report.EntrySpec
       Smos.Cursor.Report.NextSpec
+      Smos.Cursor.Report.OngoingSpec
       Smos.Cursor.Report.StuckSpec
       Smos.Cursor.Report.TimestampsSpec
       Smos.Cursor.Report.WaitingSpec

smos-report-cursor-gen/src/Smos/Cursor/Report/Ongoing/Gen.hs

@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Smos.Cursor.Report.Ongoing.Gen where
+
+import Data.GenValidity
+import Smos.Cursor.Report.Entry.Gen
+import Smos.Cursor.Report.Ongoing
+import Smos.Report.Ongoing.Gen ()
+import Test.QuickCheck
+
+instance GenValid OngoingReportCursor where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+genNonEmptyOngoingReportCursor :: Gen OngoingReportCursor
+genNonEmptyOngoingReportCursor = do
+  zone <- genValid
+  now <- genValid
+  OngoingReportCursor <$> genNonEmptyValidEntryReportCursorWith (makeOngoingEntryCursor' zone now) id genValid

smos-report-cursor-gen/src/Smos/Cursor/Report/Work/Gen.hs

@@ -11,6 +11,8 @@ import Data.GenValidity.Path ()
 import Data.Maybe
 import Smos.Cursor.Report.Entry
 import Smos.Cursor.Report.Entry.Gen
+import Smos.Cursor.Report.Ongoing
+import Smos.Cursor.Report.Ongoing.Gen
 import Smos.Cursor.Report.Stuck
 import Smos.Cursor.Report.Stuck.Gen
 import Smos.Cursor.Report.Timestamps
@@ -27,6 +29,7 @@ instance GenValid WorkReportCursor where
         checkViolationsEmpty = [wrc {workReportCursorCheckViolations = Nothing} | not $ workReportCheckViolationsEmpty wrc, workReportCursorSelection wrc /= CheckViolationsSelected]
         entriesWithoutContextEmpty = [wrc {workReportCursorEntriesWithoutContext = emptyEntryReportCursor} | not $ workReportWithoutContextEmpty wrc, workReportCursorSelection wrc /= WithoutContextSelected]
         deadlinesEmpty = [wrc {workReportCursorDeadlinesCursor = emptyTimestampsReportCursor} | not $ workReportDeadlinesEmpty wrc, workReportCursorSelection wrc /= DeadlinesSelected]
+        ongoingEmpty = [wrc {workReportCursorOngoingEntries = emptyOngoingReportCursor} | not $ workReportOngoingEmpty wrc, workReportCursorSelection wrc /= OngoingSelected]
         waitingEmpty = [wrc {workReportCursorOverdueWaiting = emptyWaitingReportCursor} | not $ workReportOverdueWaitingEmpty wrc, workReportCursorSelection wrc /= WaitingSelected]
         stuckEmpty = [wrc {workReportCursorOverdueStuck = emptyStuckReportCursor} | not $ workReportOverdueStuckEmpty wrc, workReportCursorSelection wrc /= StuckSelected]
         limboEmpty = [wrc {workReportCursorLimboProjects = Nothing} | isJust $ workReportCursorLimboProjects wrc, workReportCursorSelection wrc /= LimboSelected]
@@ -37,6 +40,7 @@ instance GenValid WorkReportCursor where
             entriesWithoutContextEmpty,
             checkViolationsEmpty,
             deadlinesEmpty,
+            ongoingEmpty,
             waitingEmpty,
             stuckEmpty,
             limboEmpty,
@@ -71,6 +75,12 @@ instance GenValid WorkReportCursor where
             tsrc <- genNonEmptyTimestampsReportCursor
             pure $ wrc {workReportCursorDeadlinesCursor = tsrc}
           else pure wrc
+      OngoingSelected ->
+        if workReportOngoingEmpty wrc
+          then do
+            erc <- genNonEmptyOngoingReportCursor
+            pure $ wrc {workReportCursorOngoingEntries = erc}
+          else pure wrc
       WaitingSelected ->
         if workReportOverdueWaitingEmpty wrc
           then do

smos-report-cursor-gen/test/Smos/Cursor/Report/OngoingSpec.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Smos.Cursor.Report.OngoingSpec where
+
+import Smos.Cursor.Report.Ongoing
+import Smos.Cursor.Report.Ongoing.Gen ()
+import Smos.Directory.Archive.Gen ()
+import Smos.Directory.ShouldPrint
+import Smos.Directory.TestUtils
+import Smos.Report.Filter.Gen ()
+import Test.Syd
+import Test.Syd.Validity
+import Test.Syd.Validity.Lens
+
+spec :: Spec
+spec = do
+  genValidSpec @OngoingReportCursor
+  describe "ongoingReportCursorNext" $ it "produces valid cursors" $ producesValid ongoingReportCursorNext
+  describe "ongoingReportCursorPrev" $ it "produces valid cursors" $ producesValid ongoingReportCursorPrev
+  describe "ongoingReportCursorFirst" $ it "produces valid cursors" $ producesValid ongoingReportCursorFirst
+  describe "ongoingReportCursorLast" $ it "produces valid cursors" $ producesValid ongoingReportCursorLast
+  describe "ongoingReportCursorSelectReport" $ it "produces valid cursors" $ producesValid ongoingReportCursorSelectReport
+  describe "ongoingReportCursorSelectFilter" $ it "produces valid cursors" $ producesValid ongoingReportCursorSelectFilter
+  describe "ongoingReportCursorInsert" $ it "produces valid cursors" $ producesValid2 ongoingReportCursorInsert
+  describe "ongoingReportCursorAppend" $ it "produces valid cursors" $ producesValid2 ongoingReportCursorAppend
+  describe "ongoingReportCursorRemove" $ it "produces valid cursors" $ producesValid ongoingReportCursorRemove
+  describe "ongoingReportCursorDelete" $ it "produces valid cursors" $ producesValid ongoingReportCursorDelete
+  describe "ongoingReportCursorEntryReportCursorL" $ lensSpec ongoingReportCursorEntryReportCursorL
+  describe "makeOngoingEntryCursor" $
+    it "produces valid cursors" $
+      forAllValid $ \zone ->
+        forAllValid $ \now -> producesValid $ makeOngoingEntryCursor zone now
+  describe "makeOngoingEntryCursor'" $
+    it "produces valid cursors" $
+      forAllValid $ \zone ->
+        forAllValid $ \now -> producesValid2 $ makeOngoingEntryCursor' zone now
+  modifyMaxSuccess (`div` 10) $
+    describe "produceOngoingReportCursor" $
+      it "produces valid reports for interesting stores" $
+        forAllValid $ \zone ->
+          forAllValid $ \now ->
+            forAllValid $ \mf ->
+              forAllValid $ \ha ->
+                withInterestingStore $ \dc -> do
+                  wrc <- produceOngoingReportCursor zone now mf ha DontPrint dc
+                  shouldBeValid wrc

smos-report-cursor/smos-report-cursor.cabal

@@ -16,6 +16,7 @@ library
   exposed-modules:
       Smos.Cursor.Report.Entry
       Smos.Cursor.Report.Next
+      Smos.Cursor.Report.Ongoing
       Smos.Cursor.Report.Streaming
       Smos.Cursor.Report.Stuck
       Smos.Cursor.Report.Timestamps

smos-report-cursor/src/Smos/Cursor/Report/Ongoing.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Smos.Cursor.Report.Ongoing where
+
+import Control.DeepSeq
+import Cursor.Forest
+import Data.Maybe
+import Data.Time
+import Data.Time.Zones
+import Data.Validity
+import Data.Validity.Path ()
+import GHC.Generics
+import Lens.Micro
+import Path
+import Smos.Cursor.Report.Entry
+import Smos.Cursor.SmosFile
+import Smos.Data
+import Smos.Directory.Archive
+import Smos.Directory.OptParse.Types
+import Smos.Directory.ShouldPrint
+import Smos.Report.Filter
+import Smos.Report.Ongoing
+
+produceOngoingReportCursor :: TZ -> UTCTime -> Maybe EntryFilter -> HideArchive -> ShouldPrint -> DirectorySettings -> IO OngoingReportCursor
+produceOngoingReportCursor zone now mf ha sp dc =
+  OngoingReportCursor
+    <$> produceEntryReportCursor (makeOngoingEntryCursor' zone now) id mf ha sp dc
+
+newtype OngoingReportCursor = OngoingReportCursor
+  { ongoingReportCursorEntryReportCursor :: EntryReportCursor BeginEnd
+  }
+  deriving (Show, Eq, Generic)
+
+instance Validity OngoingReportCursor
+
+instance NFData OngoingReportCursor
+
+ongoingReportCursorEntryReportCursorL :: Lens' OngoingReportCursor (EntryReportCursor BeginEnd)
+ongoingReportCursorEntryReportCursorL = lens ongoingReportCursorEntryReportCursor $ \wrc ne -> wrc {ongoingReportCursorEntryReportCursor = ne}
+
+emptyOngoingReportCursor :: OngoingReportCursor
+emptyOngoingReportCursor = OngoingReportCursor {ongoingReportCursorEntryReportCursor = emptyEntryReportCursor}
+
+finaliseOngoingReportCursor :: [EntryReportEntryCursor BeginEnd] -> OngoingReportCursor
+finaliseOngoingReportCursor = OngoingReportCursor . makeEntryReportCursor
+
+ongoingReportCursorBuildSmosFileCursor :: Path Abs Dir -> OngoingReportCursor -> Maybe (Path Abs File, SmosFileCursor)
+ongoingReportCursorBuildSmosFileCursor ad = entryReportCursorBuildSmosFileCursor ad . ongoingReportCursorEntryReportCursor
+
+ongoingReportCursorNext :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorNext = ongoingReportCursorEntryReportCursorL entryReportCursorNext
+
+ongoingReportCursorPrev :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorPrev = ongoingReportCursorEntryReportCursorL entryReportCursorPrev
+
+ongoingReportCursorFirst :: OngoingReportCursor -> OngoingReportCursor
+ongoingReportCursorFirst = ongoingReportCursorEntryReportCursorL %~ entryReportCursorFirst
+
+ongoingReportCursorLast :: OngoingReportCursor -> OngoingReportCursor
+ongoingReportCursorLast = ongoingReportCursorEntryReportCursorL %~ entryReportCursorLast
+
+ongoingReportCursorSelectReport :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorSelectReport = ongoingReportCursorEntryReportCursorL entryReportCursorSelectReport
+
+ongoingReportCursorSelectFilter :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorSelectFilter = ongoingReportCursorEntryReportCursorL entryReportCursorSelectFilter
+
+ongoingReportCursorInsert :: Char -> OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorInsert c = ongoingReportCursorEntryReportCursorL $ entryReportCursorInsert c
+
+ongoingReportCursorAppend :: Char -> OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorAppend c = ongoingReportCursorEntryReportCursorL $ entryReportCursorAppend c
+
+ongoingReportCursorRemove :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorRemove = ongoingReportCursorEntryReportCursorL entryReportCursorRemove
+
+ongoingReportCursorDelete :: OngoingReportCursor -> Maybe OngoingReportCursor
+ongoingReportCursorDelete = ongoingReportCursorEntryReportCursorL entryReportCursorDelete
+
+makeOngoingEntryCursor' :: TZ -> UTCTime -> Path Rel File -> ForestCursor Entry Entry -> [BeginEnd]
+makeOngoingEntryCursor' zone now _ = maybeToList . makeOngoingEntryCursor zone now
+
+makeOngoingEntryCursor :: TZ -> UTCTime -> ForestCursor Entry Entry -> Maybe BeginEnd
+makeOngoingEntryCursor zone now = parseMatchingBeginEnd zone now . forestCursorCurrent

smos-report-cursor/src/Smos/Cursor/Report/Work.hs

@@ -19,6 +19,7 @@ import GHC.Generics
 import Lens.Micro
 import Path
 import Smos.Cursor.Report.Entry
+import Smos.Cursor.Report.Ongoing
 import Smos.Cursor.Report.Stuck
 import Smos.Cursor.Report.Timestamps
 import Smos.Cursor.Report.Waiting
@@ -41,6 +42,7 @@ data WorkReportCursor = WorkReportCursor
   { workReportCursorNextBeginCursor :: !(Maybe (EntryReportEntryCursor (TimestampName, Timestamp))),
     workReportCursorEntriesWithoutContext :: !(EntryReportCursor ()),
     workReportCursorCheckViolations :: !(Maybe (MapCursor EntryFilter (EntryReportCursor ()))),
+    workReportCursorOngoingEntries :: !OngoingReportCursor,
     workReportCursorDeadlinesCursor :: !TimestampsReportCursor,
     workReportCursorOverdueWaiting :: !WaitingReportCursor,
     workReportCursorOverdueStuck :: !StuckReportCursor,
@@ -59,6 +61,7 @@ instance Validity WorkReportCursor where
             NextBeginSelected -> not $ workReportNextBeginEmpty wrc
             WithoutContextSelected -> not $ workReportWithoutContextEmpty wrc
             CheckViolationsSelected -> not $ workReportCheckViolationsEmpty wrc
+            OngoingSelected -> not $ workReportOngoingEmpty wrc
             DeadlinesSelected -> not $ workReportDeadlinesEmpty wrc
             WaitingSelected -> not $ workReportOverdueWaitingEmpty wrc
             StuckSelected -> not $ workReportOverdueStuckEmpty wrc
@@ -77,6 +80,7 @@ emptyWorkReportCursor =
     { workReportCursorNextBeginCursor = Nothing,
       workReportCursorEntriesWithoutContext = emptyEntryReportCursor,
       workReportCursorCheckViolations = Nothing,
+      workReportCursorOngoingEntries = emptyOngoingReportCursor,
       workReportCursorDeadlinesCursor = emptyTimestampsReportCursor,
       workReportCursorOverdueWaiting = emptyWaitingReportCursor,
       workReportCursorOverdueStuck = emptyStuckReportCursor,
@@ -87,7 +91,7 @@ emptyWorkReportCursor =
 
 intermediateWorkReportToWorkReportCursor :: WorkReportContext -> IntermediateWorkReport -> WorkReportCursor
 intermediateWorkReportToWorkReportCursor WorkReportContext {..} IntermediateWorkReport {..} =
-  let IntermediateWorkReport _ _ _ _ _ _ _ _ = undefined
+  let IntermediateWorkReport _ _ _ _ _ _ _ _ _ = undefined
       workReportCursorNextBeginCursor = (\(rf, fc, tsn, ts) -> makeEntryReportEntryCursor rf fc (tsn, ts)) <$> intermediateWorkReportNextBegin
       workReportCursorEntriesWithoutContext = makeEntryReportCursor $
         flip map (DList.toList intermediateWorkReportEntriesWithoutContext) $ \(rf, fc) ->
@@ -102,6 +106,10 @@ intermediateWorkReportToWorkReportCursor WorkReportContext {..} IntermediateWork
                 )
             )
           <$> NE.nonEmpty (M.toList intermediateWorkReportCheckViolations)
+      workReportCursorOngoingEntries =
+        finaliseOngoingReportCursor $
+          flip map (DList.toList intermediateWorkReportOngoingEntries) $ \(rf, fc, be) ->
+            makeEntryReportEntryCursor rf fc be
       workReportCursorDeadlinesCursor = finaliseTimestampsReportCursor $
         flip map (DList.toList intermediateWorkReportAgendaEntries) $ \(rf, fc, tsn, ts) ->
           makeEntryReportEntryCursor rf fc (TimestampsEntryCursor tsn ts)
@@ -135,6 +143,7 @@ data WorkReportCursorSelection
   | StuckSelected
   | LimboSelected
   | DeadlinesSelected
+  | OngoingSelected
   | NextBeginSelected
   deriving (Show, Eq, Generic)
 
@@ -154,6 +163,9 @@ workReportCursorEntriesWithoutContextL = lens workReportCursorEntriesWithoutCont
 workReportCursorDeadlinesL :: Lens' WorkReportCursor TimestampsReportCursor
 workReportCursorDeadlinesL = lens workReportCursorDeadlinesCursor $ \wrc rc -> wrc {workReportCursorDeadlinesCursor = rc}
 
+workReportCursorOngoingL :: Lens' WorkReportCursor OngoingReportCursor
+workReportCursorOngoingL = lens workReportCursorOngoingEntries $ \wrc rc -> wrc {workReportCursorOngoingEntries = rc}
+
 workReportCursorOverdueWaitingL :: Lens' WorkReportCursor WaitingReportCursor
 workReportCursorOverdueWaitingL = lens workReportCursorOverdueWaiting $ \wrc rc -> wrc {workReportCursorOverdueWaiting = rc}
 
@@ -178,12 +190,18 @@ workReportCheckViolationsEmpty = isNothing . workReportCursorCheckViolations
 workReportDeadlinesEmpty :: WorkReportCursor -> Bool
 workReportDeadlinesEmpty = isNothing . entryReportCursorSelectedEntryReportEntryCursors . timestampsReportCursorEntryReportCursor . workReportCursorDeadlinesCursor
 
+workReportOngoingEmpty :: WorkReportCursor -> Bool
+workReportOngoingEmpty = isNothing . entryReportCursorSelectedEntryReportEntryCursors . ongoingReportCursorEntryReportCursor . workReportCursorOngoingEntries
+
 workReportOverdueWaitingEmpty :: WorkReportCursor -> Bool
 workReportOverdueWaitingEmpty = isNothing . entryReportCursorSelectedEntryReportEntryCursors . waitingReportCursorEntryReportCursor . workReportCursorOverdueWaiting
 
 workReportOverdueStuckEmpty :: WorkReportCursor -> Bool
 workReportOverdueStuckEmpty = isNothing . stuckReportCursorNonEmptyCursor . workReportCursorOverdueStuck
 
+workReportLimboEmpty :: WorkReportCursor -> Bool
+workReportLimboEmpty = isNothing . workReportCursorLimboProjects
+
 workReportResultsEmpty :: WorkReportCursor -> Bool
 workReportResultsEmpty = isNothing . entryReportCursorSelectedEntryReportEntryCursors . workReportCursorResultEntries
 
@@ -238,18 +256,25 @@ workReportCursorNext wrc = case workReportCursorSelection wrc of
             then workReportCursorNext wrc' -- If there were deadlines entries, keep going.
             else Just wrc'
   CheckViolationsSelected -> case workReportCursorCheckViolationsL checkViolationsNext wrc of
+    Just wrc' -> Just wrc'
+    Nothing ->
+      let wrc' = wrc {workReportCursorSelection = OngoingSelected}
+       in if workReportOngoingEmpty wrc'
+            then workReportCursorNext wrc' -- If there are no entries without context, keep going.
+            else Just wrc'
+  OngoingSelected -> case workReportCursorOngoingL ongoingReportCursorNext wrc of
     Just wrc' -> Just wrc'
     Nothing ->
       let wrc' = wrc {workReportCursorSelection = DeadlinesSelected}
        in if workReportDeadlinesEmpty wrc'
-            then workReportCursorNext wrc' -- If there are no entries without context, keep going.
+            then workReportCursorNext wrc' -- If there were no waiting entries, keep going.
             else Just wrc'
   DeadlinesSelected -> case workReportCursorDeadlinesL timestampsReportCursorNext wrc of
     Just wrc' -> Just wrc'
     Nothing ->
       let wrc' = wrc {workReportCursorSelection = WaitingSelected}
        in if workReportOverdueWaitingEmpty wrc'
-            then workReportCursorNext wrc' -- If there were no waiting entries, keep going.
+            then workReportCursorNext wrc' -- If there were no ongoing entries, keep going.
             else Just wrc'
   WaitingSelected -> case workReportCursorOverdueWaitingL waitingReportCursorNext wrc of
     Just wrc' -> Just wrc'
@@ -265,11 +290,9 @@ workReportCursorNext wrc = case workReportCursorSelection wrc of
        in if isNothing $ workReportCursorLimboProjects wrc'
             then workReportCursorNext wrc' -- If there are no limbo projects, keep going.
             else Just wrc'
-  LimboSelected -> case workReportCursorLimboProjects wrc of
+  LimboSelected -> case workReportCursorLimboProjects wrc >>= nonEmptyCursorSelectNext of
-    Nothing -> Just $ wrc {workReportCursorSelection = ResultsSelected} -- Should not happen
+    Just nec' -> Just $ wrc {workReportCursorLimboProjects = Just nec'}
-    Just nec -> case nonEmptyCursorSelectNext nec of
+    Nothing -> Just $ wrc {workReportCursorSelection = ResultsSelected}
-      Nothing -> Just $ wrc {workReportCursorSelection = ResultsSelected}
-      Just nec' -> Just $ wrc {workReportCursorLimboProjects = Just nec'}
   -- Even if there are no results, we stay in the results
   ResultsSelected -> workReportCursorResultEntriesL entryReportCursorNext wrc
 
@@ -288,11 +311,18 @@ workReportCursorPrev wrc = case workReportCursorSelection wrc of
        in if workReportWithoutContextEmpty wrc'
             then workReportCursorPrev wrc' -- If there are no entries without context, keep going.
             else Just wrc'
-  DeadlinesSelected -> case workReportCursorDeadlinesL timestampsReportCursorPrev wrc of
+  OngoingSelected -> case workReportCursorOngoingL ongoingReportCursorPrev wrc of
     Just wrc' -> Just wrc'
     Nothing ->
       let wrc' = wrc {workReportCursorSelection = CheckViolationsSelected}
        in if workReportCheckViolationsEmpty wrc'
+            then workReportCursorPrev wrc' -- If there are no deadlines, keep looking up.
+            else Just wrc'
+  DeadlinesSelected -> case workReportCursorDeadlinesL timestampsReportCursorPrev wrc of
+    Just wrc' -> Just wrc'
+    Nothing ->
+      let wrc' = wrc {workReportCursorSelection = OngoingSelected}
+       in if workReportOngoingEmpty wrc'
             then workReportCursorPrev wrc' -- If there are no check violations, keep going.
             else Just wrc'
   WaitingSelected -> case workReportCursorOverdueWaitingL waitingReportCursorPrev wrc of
@@ -300,7 +330,7 @@ workReportCursorPrev wrc = case workReportCursorSelection wrc of
     Nothing ->
       let wrc' = wrc {workReportCursorSelection = DeadlinesSelected}
        in if workReportDeadlinesEmpty wrc'
-            then workReportCursorPrev wrc' -- If there are no deadlines, keep looking up
+            then workReportCursorPrev wrc' -- If there are no ongoing entries, keep looking up
             else Just wrc'
   StuckSelected -> case workReportCursorOverdueStuckL stuckReportCursorPrev wrc of
     Just wrc' -> Just wrc'
@@ -309,32 +339,31 @@ workReportCursorPrev wrc = case workReportCursorSelection wrc of
        in if workReportOverdueWaitingEmpty wrc'
             then workReportCursorPrev wrc' -- If there are no waiting entries, keep looking up
             else Just wrc'
-  LimboSelected -> case workReportCursorLimboProjects wrc of
+  LimboSelected -> case workReportCursorLimboProjects wrc >>= nonEmptyCursorSelectPrev of
-    Nothing -> Just $ wrc {workReportCursorSelection = StuckSelected} -- Should not happen
+    Just nec' -> Just $ wrc {workReportCursorLimboProjects = Just nec'}
-    Just nec -> case nonEmptyCursorSelectPrev nec of
+    Nothing ->
-      Nothing ->
+      let wrc' = wrc {workReportCursorSelection = StuckSelected}
-        let wrc' = wrc {workReportCursorSelection = StuckSelected}
+       in if workReportOverdueStuckEmpty wrc'
-         in if workReportOverdueStuckEmpty wrc'
+            then workReportCursorPrev wrc' -- If there are no stuck projects, keep looking up.
-              then workReportCursorPrev wrc' -- If there are no stuck projects, keep looking up.
+            else Just wrc'
-              else Just wrc'
-      Just nec' -> Just $ wrc {workReportCursorLimboProjects = Just nec'}
   ResultsSelected -> case workReportCursorResultEntriesL entryReportCursorPrev wrc of
     Just wrc' -> Just wrc'
     Nothing ->
       let wrc' = wrc {workReportCursorSelection = LimboSelected}
-       in if isNothing $ workReportCursorLimboProjects wrc'
+       in if workReportLimboEmpty wrc'
             then workReportCursorPrev wrc' -- If there are no limbo projects, keep looking up
             else Just wrc'
 
 workReportCursorFirst :: WorkReportCursor -> WorkReportCursor
 workReportCursorFirst wrc =
-  let WorkReportCursor _ _ _ _ _ _ _ _ _ = undefined
+  let WorkReportCursor _ _ _ _ _ _ _ _ _ _ = undefined
       wrc' =
         wrc
           & workReportCursorSelectionL .~ NextBeginSelected
           & workReportCursorCheckViolationsL %~ checkViolationsFirst
           & workReportCursorEntriesWithoutContextL %~ entryReportCursorFirst
           & workReportCursorDeadlinesL %~ timestampsReportCursorFirst
+          & workReportCursorOngoingL %~ ongoingReportCursorFirst
           & workReportCursorOverdueWaitingL %~ waitingReportCursorFirst
           & workReportCursorOverdueStuckL %~ stuckReportCursorFirst
           & workReportCursorLimboProjectsL %~ fmap nonEmptyCursorSelectFirst
@@ -347,12 +376,13 @@ workReportCursorFirst wrc =
 
 workReportCursorLast :: WorkReportCursor -> WorkReportCursor
 workReportCursorLast wrc =
-  let WorkReportCursor _ _ _ _ _ _ _ _ _ = undefined
+  let WorkReportCursor _ _ _ _ _ _ _ _ _ _ = undefined
    in wrc
         & workReportCursorSelectionL .~ ResultsSelected
         & workReportCursorCheckViolationsL %~ checkViolationsLast
         & workReportCursorEntriesWithoutContextL %~ entryReportCursorLast
         & workReportCursorDeadlinesL %~ timestampsReportCursorLast
+        & workReportCursorOngoingL %~ ongoingReportCursorLast
         & workReportCursorOverdueWaitingL %~ waitingReportCursorLast
         & workReportCursorOverdueStuckL %~ stuckReportCursorLast
         & workReportCursorLimboProjectsL %~ fmap nonEmptyCursorSelectLast

smos-report-gen/smos-report-gen.cabal

@@ -67,6 +67,7 @@ library
       Smos.Report.Filter.Gen
       Smos.Report.Free.Gen
       Smos.Report.Next.Gen
+      Smos.Report.Ongoing.Gen
       Smos.Report.OptParse.Gen
       Smos.Report.Period.Gen
       Smos.Report.Projection.Gen
@@ -117,6 +118,7 @@ test-suite smos-report-test
       Smos.Report.FreeSpec
       Smos.Report.LogSpec
       Smos.Report.NextSpec
+      Smos.Report.OngoingSpec
       Smos.Report.PeriodSpec
       Smos.Report.ProjectionSpec
       Smos.Report.ProjectsSpec

smos-report-gen/src/Smos/Report/Ongoing/Gen.hs

@@ -0,0 +1,23 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Smos.Report.Ongoing.Gen where
+
+import Data.GenValidity
+import Data.GenValidity.Path ()
+import Smos.Data.Gen ()
+import Smos.Report.Ongoing
+import Smos.Report.Period.Gen ()
+import Smos.Report.Time.Gen ()
+import Smos.Report.TimeBlock.Gen ()
+
+instance GenValid OngoingReport where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance GenValid OngoingEntry where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+
+instance GenValid BeginEnd where
+  genValid = genValidStructurallyWithoutExtraChecking
+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering

smos-report-gen/src/Smos/Report/Work/Gen.hs

@@ -11,6 +11,7 @@ import Smos.Data.Gen ()
 import Smos.Report.Agenda
 import Smos.Report.Agenda.Gen ()
 import Smos.Report.Filter.Gen ()
+import Smos.Report.Ongoing.Gen ()
 import Smos.Report.OptParse.Gen ()
 import Smos.Report.Period.Gen ()
 import Smos.Report.Sorter.Gen ()
@@ -42,4 +43,5 @@ instance GenValid WorkReport where
       <*> genValid
       <*> genValid
       <*> genValid
+      <*> genValid
   shrinkValid = shrinkValidStructurally

smos-report-gen/test/Smos/Report/OngoingSpec.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Smos.Report.OngoingSpec where
+
+import qualified Data.Map as M
+import Data.Time
+import Data.Time.Zones.All
+import Smos.Data
+import Smos.Directory.Archive.Gen ()
+import Smos.Directory.ShouldPrint
+import Smos.Directory.TestUtils
+import Smos.Report.Filter.Gen ()
+import Smos.Report.Ongoing
+import Smos.Report.Ongoing.Gen ()
+import Test.Syd
+import Test.Syd.Validity
+import Test.Syd.Validity.Aeson
+
+spec :: Spec
+spec = do
+  genValidSpec @OngoingReport
+  jsonSpec @OngoingReport
+  genValidSpec @OngoingEntry
+  jsonSpec @OngoingEntry
+  modifyMaxSuccess (`div` 10) $
+    describe "produceOngoingReport" $
+      it "produces valid reports for interesting stores" $
+        forAllValid $ \zone ->
+          forAllValid $ \now ->
+            forAllValid $ \mFilter ->
+              forAllValid $ \ha ->
+                withInterestingStore $ \dc -> do
+                  wr <- produceOngoingReport zone now mFilter ha DontPrint dc
+                  shouldBeValid wr
+
+  describe "parseOngoingEntry" $ do
+    it "always uses the appropriate filepath and header if it parses something" $
+      forAllValid $ \zone ->
+        forAllValid $ \now ->
+          forAllValid $ \rf ->
+            forAllValid $ \e -> do
+              case parseOngoingEntry zone now rf e of
+                Nothing -> pure () -- Fine
+                Just OngoingEntry {..} -> do
+                  ongoingEntryFilePath `shouldBe` rf
+                  ongoingEntryHeader `shouldBe` entryHeader e
+
+    let zone = tzByLabel Europe__Zurich
+        now = UTCTime (fromGregorian 2023 09 11) (timeOfDayToTime (TimeOfDay 12 14 00))
+
+    it "can parse a OnlyBegin" $
+      forAllValid $ \rf ->
+        forAllValid $ \h -> do
+          let begin = TimestampDay (fromGregorian 2023 09 10)
+              e = (newEntry h) {entryTimestamps = M.fromList [("BEGIN", begin)]}
+          case parseOngoingEntry zone now rf e of
+            Nothing -> expectationFailure "Should have found an OngoingEntry"
+            Just OngoingEntry {..} -> ongoingEntryBeginEnd `shouldBe` OnlyBegin begin
+
+    it "can parse a OnlyEnd" $
+      forAllValid $ \rf ->
+        forAllValid $ \h -> do
+          let end = TimestampDay (fromGregorian 2023 09 15)
+              e = (newEntry h) {entryTimestamps = M.fromList [("END", end)]}
+          case parseOngoingEntry zone now rf e of
+            Nothing -> expectationFailure "Should have found an OngoingEntry"
+            Just OngoingEntry {..} -> ongoingEntryBeginEnd `shouldBe` OnlyEnd end
+
+    it "can parse a BeginEnd" $
+      forAllValid $ \rf ->
+        forAllValid $ \h -> do
+          let begin = TimestampDay (fromGregorian 2023 09 09)
+              end = TimestampDay (fromGregorian 2023 09 16)
+              e = (newEntry h) {entryTimestamps = M.fromList [("BEGIN", begin), ("END", end)]}
+          case parseOngoingEntry zone now rf e of
+            Nothing -> expectationFailure "Should have found an OngoingEntry"
+            Just OngoingEntry {..} -> ongoingEntryBeginEnd `shouldBe` BeginEnd begin end

smos-report/smos-report.cabal

@@ -24,6 +24,7 @@ library
       Smos.Report.Free
       Smos.Report.Log
       Smos.Report.Next
+      Smos.Report.Ongoing
       Smos.Report.OptParse
       Smos.Report.OptParse.Types
       Smos.Report.Period

smos-report/src/Smos/Report/Ongoing.hs

@@ -0,0 +1,179 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Smos.Report.Ongoing where
+
+import Autodocodec
+import Conduit
+import Control.DeepSeq
+import Control.Monad
+import Data.Aeson (FromJSON, ToJSON)
+import qualified Data.Conduit.Combinators as C
+import qualified Data.Map as M
+import Data.Time
+import Data.Time.Zones
+import Data.Validity
+import Data.Validity.Path ()
+import GHC.Generics
+import Path
+import Smos.Data
+import Smos.Directory.Archive
+import Smos.Directory.OptParse.Types
+import Smos.Directory.ShouldPrint
+import Smos.Directory.Streaming
+import Smos.Report.Filter
+import Text.Printf
+
+produceOngoingReport ::
+  MonadIO m =>
+  TZ ->
+  UTCTime ->
+  Maybe EntryFilter ->
+  HideArchive ->
+  ShouldPrint ->
+  DirectorySettings ->
+  m OngoingReport
+produceOngoingReport zone now ef ha sp dc =
+  produceReport ha sp dc (ongoingReportConduit zone now ef)
+
+ongoingReportConduit ::
+  Monad m =>
+  TZ ->
+  UTCTime ->
+  Maybe EntryFilter ->
+  ConduitT (Path Rel File, SmosFile) void m OngoingReport
+ongoingReportConduit zone now ef =
+  OngoingReport
+    <$> ( smosFileCursors
+            .| C.filter (maybe (const True) filterPredicate ef)
+            .| smosCursorCurrents
+            .| C.concatMap (uncurry (parseOngoingEntry zone now))
+            .| sinkList
+        )
+
+parseOngoingEntry :: TZ -> UTCTime -> Path Rel File -> Entry -> Maybe OngoingEntry
+parseOngoingEntry zone now ongoingEntryFilePath e = do
+  let ongoingEntryHeader = entryHeader e
+  ongoingEntryBeginEnd <- parseMatchingBeginEnd zone now e
+  pure $ OngoingEntry {..}
+
+parseMatchingBeginEnd :: TZ -> UTCTime -> Entry -> Maybe BeginEnd
+parseMatchingBeginEnd zone now e = do
+  be <-
+    parseBeginEnd
+      (M.lookup "BEGIN" (entryTimestamps e))
+      (M.lookup "END" (entryTimestamps e))
+  guard $ beginEndMatches zone now be
+  guard $ not $ entryIsDone e
+  pure be
+
+newtype OngoingReport = OngoingReport
+  { ongoingReportEntries :: [OngoingEntry]
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON) via (Autodocodec OngoingReport)
+
+instance Validity OngoingReport
+
+instance NFData OngoingReport
+
+instance HasCodec OngoingReport where
+  codec = dimapCodec OngoingReport ongoingReportEntries codec
+
+data OngoingEntry = OngoingEntry
+  { -- The path within the workflow directory
+    ongoingEntryFilePath :: !(Path Rel File),
+    ongoingEntryHeader :: !Header,
+    ongoingEntryBeginEnd :: !BeginEnd
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON) via (Autodocodec OngoingEntry)
+
+instance Validity OngoingEntry
+
+instance NFData OngoingEntry
+
+instance HasCodec OngoingEntry where
+  codec =
+    object "OngoingEntry" $
+      OngoingEntry
+        <$> requiredField "path" "The path of the file in which this entry was found"
+          .= ongoingEntryFilePath
+        <*> requiredField "header" "The header of the entry"
+          .= ongoingEntryHeader
+        <*> objectCodec
+          .= ongoingEntryBeginEnd
+
+data BeginEnd
+  = OnlyBegin !Timestamp
+  | OnlyEnd !Timestamp
+  | BeginEnd !Timestamp !Timestamp
+  deriving stock (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON) via (Autodocodec BeginEnd)
+
+instance Validity BeginEnd
+
+instance NFData BeginEnd
+
+instance HasCodec BeginEnd where
+  codec = object "BeginEnd" objectCodec
+
+instance HasObjectCodec BeginEnd where
+  objectCodec =
+    bimapCodec
+      ( \(mBegin, mEnd) -> case parseBeginEnd mBegin mEnd of
+          Nothing -> Left "Either begin or end is required."
+          Just be -> Right be
+      )
+      renderBeginEnd
+      $ (,)
+        <$> optionalField "begin" "begin timestamp"
+          .= fst
+        <*> optionalField "end" "end timestamp"
+          .= snd
+
+parseBeginEnd :: Maybe Timestamp -> Maybe Timestamp -> Maybe BeginEnd
+parseBeginEnd mBegin mEnd = case (mBegin, mEnd) of
+  (Nothing, Nothing) -> Nothing
+  (Just begin, Nothing) -> Just $ OnlyBegin begin
+  (Nothing, Just end) -> Just $ OnlyEnd end
+  (Just begin, Just end) -> Just $ BeginEnd begin end
+
+renderBeginEnd :: BeginEnd -> (Maybe Timestamp, Maybe Timestamp)
+renderBeginEnd = \case
+  OnlyBegin begin -> (Just begin, Nothing)
+  OnlyEnd end -> (Nothing, Just end)
+  BeginEnd begin end -> (Just begin, Just end)
+
+beginEndMatches :: TZ -> UTCTime -> BeginEnd -> Bool
+beginEndMatches zone now be =
+  let localNow = utcToLocalTimeTZ zone now
+      today = localDay localNow
+      beginCondition begin =
+        case begin of
+          TimestampDay d -> d <= today
+          TimestampLocalTime lt -> lt <= localNow
+      endCondition end =
+        case end of
+          TimestampDay d -> today <= d
+          TimestampLocalTime lt -> localNow <= lt
+   in case be of
+        OnlyBegin begin -> beginCondition begin
+        OnlyEnd end -> endCondition end
+        BeginEnd begin end -> beginCondition begin && endCondition end
+
+beginEndPercentageString :: LocalTime -> Timestamp -> Timestamp -> String
+beginEndPercentageString nowLocal begin end =
+  let today = localDay nowLocal
+   in case (begin, end) of
+        (TimestampDay bd, TimestampDay ed) ->
+          printf "% 3d / % 3d" (diffDays today bd + 1) (diffDays ed bd + 1)
+        _ ->
+          let r :: Float
+              r =
+                realToFrac (diffLocalTime nowLocal (timestampLocalTime begin))
+                  / realToFrac (diffLocalTime (timestampLocalTime end) (timestampLocalTime begin))
+           in printf "% 3.f%%" $ 100 * r

smos-report/src/Smos/Report/Work.hs

@@ -33,6 +33,7 @@ import Smos.Directory.Streaming
 import Smos.Report.Agenda
 import Smos.Report.Comparison
 import Smos.Report.Filter
+import Smos.Report.Ongoing
 import Smos.Report.OptParse.Types
 import Smos.Report.Projects
 import Smos.Report.Sorter
@@ -60,6 +61,7 @@ intermediateWorkReportConduit wrc =
 data IntermediateWorkReport = IntermediateWorkReport
   { intermediateWorkReportResultEntries :: !(DList (Path Rel File, ForestCursor Entry)),
     intermediateWorkReportAgendaEntries :: !(DList (Path Rel File, ForestCursor Entry, TimestampName, Timestamp)),
+    intermediateWorkReportOngoingEntries :: !(DList (Path Rel File, ForestCursor Entry, BeginEnd)),
     intermediateWorkReportNextBegin :: !(Maybe (Path Rel File, ForestCursor Entry, TimestampName, Timestamp)),
     intermediateWorkReportOverdueWaiting :: !(DList (Path Rel File, ForestCursor Entry, UTCTime, Maybe Time)),
     intermediateWorkReportOverdueStuck :: !(DList StuckReportEntry),
@@ -76,6 +78,7 @@ instance Semigroup IntermediateWorkReport where
     IntermediateWorkReport
       { intermediateWorkReportResultEntries = intermediateWorkReportResultEntries wr1 <> intermediateWorkReportResultEntries wr2,
         intermediateWorkReportAgendaEntries = intermediateWorkReportAgendaEntries wr1 <> intermediateWorkReportAgendaEntries wr2,
+        intermediateWorkReportOngoingEntries = intermediateWorkReportOngoingEntries wr1 <> intermediateWorkReportOngoingEntries wr2,
         intermediateWorkReportNextBegin = case (intermediateWorkReportNextBegin wr1, intermediateWorkReportNextBegin wr2) of
           (Nothing, Nothing) -> Nothing
           (Just ae, Nothing) -> Just ae
@@ -99,6 +102,7 @@ instance Monoid IntermediateWorkReport where
     IntermediateWorkReport
       { intermediateWorkReportResultEntries = mempty,
         intermediateWorkReportAgendaEntries = mempty,
+        intermediateWorkReportOngoingEntries = mempty,
         intermediateWorkReportNextBegin = Nothing,
         intermediateWorkReportOverdueWaiting = mempty,
         intermediateWorkReportOverdueStuck = mempty,
@@ -202,8 +206,10 @@ makeIntermediateWorkReport WorkReportContext {..} rp fc =
                             t
       currentFilter :: Maybe EntryFilter
       currentFilter = filterMWithBase $ combineMFilter totalCurrent workReportContextAdditionalFilter
+      e :: Entry
+      e = forestCursorCurrent fc
       nowIsAfterAfter =
-        case M.lookup "AFTER" (entryTimestamps (forestCursorCurrent fc)) of
+        case M.lookup "AFTER" (entryTimestamps e) of
           Nothing -> True
           Just afterTimestamp -> case afterTimestamp of
             TimestampDay d -> today > d
@@ -227,19 +233,24 @@ makeIntermediateWorkReport WorkReportContext {..} rp fc =
                     "AFTER" -> False
                     _ -> day == today
          in filter go allAgendaQuadruples
-      isBusy :: Maybe Bool
+      mOngoingEntry :: Maybe (Path Rel File, ForestCursor Entry, BeginEnd)
-      isBusy = do
+      mOngoingEntry = do
-        pv <- M.lookup "busy" (entryProperties (forestCursorCurrent fc))
+        beginEnd <- parseMatchingBeginEnd workReportContextTimeZone workReportContextNow e
-        case pv of
+        pure (rp, fc, beginEnd)
-          "true" -> Just True
-          "false" -> Just False
-          _ -> Nothing
       beginEntries :: [(Path Rel File, ForestCursor Entry, TimestampName, Timestamp)]
       beginEntries =
         let go (_, _, tsn, ts) = case tsn of
               "BEGIN" -> fromMaybe True isBusy && timestampLocalTime ts >= nowLocal
               _ -> False
          in sortAgendaQuadruples $ filter go allAgendaQuadruples
+        where
+          isBusy :: Maybe Bool
+          isBusy = do
+            pv <- M.lookup "busy" (entryProperties e)
+            case pv of
+              "true" -> Just True
+              "false" -> Just False
+              _ -> Nothing
       nextBeginEntry :: Maybe (Path Rel File, ForestCursor Entry, TimestampName, Timestamp)
       nextBeginEntry = headMay beginEntries
       mWaitingEntry :: Maybe (Path Rel File, ForestCursor Entry, UTCTime, Maybe Time)
@@ -252,6 +263,7 @@ makeIntermediateWorkReport WorkReportContext {..} rp fc =
    in IntermediateWorkReport
         { intermediateWorkReportResultEntries = match $ matchesSelectedContext && nowIsAfterAfter,
           intermediateWorkReportAgendaEntries = DList.fromList agendaQuadruples,
+          intermediateWorkReportOngoingEntries = maybeToDList mOngoingEntry,
           intermediateWorkReportNextBegin = nextBeginEntry,
           intermediateWorkReportOverdueWaiting = maybeToDList mWaitingEntry,
           intermediateWorkReportOverdueStuck = mempty,
@@ -275,6 +287,7 @@ makeIntermediateWorkReport WorkReportContext {..} rp fc =
 data WorkReport = WorkReport
   { workReportResultEntries :: ![(Path Rel File, ForestCursor Entry)],
     workReportAgendaEntries :: ![AgendaEntry],
+    workReportOngoingEntries :: ![OngoingEntry],
     workReportNextBegin :: !(Maybe AgendaEntry),
     workReportOverdueWaiting :: ![WaitingEntry],
     workReportOverdueStuck :: ![StuckReportEntry],
@@ -305,6 +318,12 @@ finishWorkReport zone now mpn mt ms wr =
    in WorkReport
         { workReportAgendaEntries = sortAgendaEntries $ map agendaQuadrupleToAgendaEntry $ DList.toList $ intermediateWorkReportAgendaEntries wr,
           workReportResultEntries = sortCursorList $ applyAutoFilter $ DList.toList $ intermediateWorkReportResultEntries wr,
+          workReportOngoingEntries = flip map (DList.toList $ intermediateWorkReportOngoingEntries wr) $ \(rf, fc, be) ->
+            OngoingEntry
+              { ongoingEntryFilePath = rf,
+                ongoingEntryHeader = entryHeader (forestCursorCurrent fc),
+                ongoingEntryBeginEnd = be
+              },
           workReportNextBegin = agendaQuadrupleToAgendaEntry <$> intermediateWorkReportNextBegin wr,
           workReportOverdueWaiting = sortWaitingEntries $ map waitingQuadrupleToWaitingEntry $ DList.toList $ intermediateWorkReportOverdueWaiting wr,
           workReportOverdueStuck = sortStuckEntries $ DList.toList $ intermediateWorkReportOverdueStuck wr,

smos/smos.cabal

@@ -87,6 +87,7 @@ library
       Smos.Actions.Help
       Smos.Actions.Report
       Smos.Actions.Report.Next
+      Smos.Actions.Report.Ongoing
       Smos.Actions.Report.Stuck
       Smos.Actions.Report.Timestamps
       Smos.Actions.Report.Waiting

smos/src/Smos/Actions.hs

@@ -20,6 +20,7 @@ module Smos.Actions
     module Smos.Actions.Report,
     module Smos.Actions.Report.Next,
     module Smos.Actions.Report.Waiting,
+    module Smos.Actions.Report.Ongoing,
     module Smos.Actions.Report.Timestamps,
     module Smos.Actions.Report.Stuck,
     module Smos.Actions.Report.Work,
@@ -42,6 +43,7 @@ import Smos.Actions.Forest
 import Smos.Actions.Help
 import Smos.Actions.Report
 import Smos.Actions.Report.Next
+import Smos.Actions.Report.Ongoing
 import Smos.Actions.Report.Stuck
 import Smos.Actions.Report.Timestamps
 import Smos.Actions.Report.Waiting

smos/src/Smos/Actions/Report.hs

@@ -5,6 +5,7 @@ module Smos.Actions.Report where
 import Smos.Actions.Browser
 import Smos.Actions.File
 import Smos.Actions.Report.Next
+import Smos.Actions.Report.Ongoing
 import Smos.Actions.Report.Stuck
 import Smos.Actions.Report.Timestamps
 import Smos.Actions.Report.Waiting
@@ -17,6 +18,7 @@ allPlainReportActions =
     [ allPlainReportExitActions,
       allPlainReportNextActions,
       allPlainReportWaitingActions,
+      allPlainReportOngoingActions,
       allPlainReportTimestampsActions,
       allPlainReportStuckActions,
       allPlainReportWorkActions
@@ -32,6 +34,7 @@ allReportUsingActions =
   concat
     [ allReportNextActionsUsingActions,
       allReportWaitingUsingActions,
+      allReportOngoingUsingActions,
       allReportTimestampsUsingActions,
       allReportStuckUsingActions,
       allReportWorkUsingActions

smos/src/Smos/Actions/Report/Ongoing.hs

@@ -0,0 +1,148 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Smos.Actions.Report.Ongoing where
+
+import Smos.Actions.File
+import Smos.Actions.Utils
+import Smos.Directory.Archive
+import Smos.Directory.Resolution
+import Smos.Directory.ShouldPrint
+import Smos.Report.OptParse.Types
+import Smos.Types
+
+allPlainReportOngoingActions :: [Action]
+allPlainReportOngoingActions =
+  [ reportOngoing,
+    prevOngoing,
+    nextOngoing,
+    firstOngoing,
+    lastOngoing,
+    enterOngoingFile,
+    selectOngoingReport,
+    selectOngoingFilter,
+    removeOngoingFilter,
+    deleteOngoingFilter
+  ]
+
+allReportOngoingUsingActions :: [ActionUsing Char]
+allReportOngoingUsingActions =
+  [ insertOngoingFilter,
+    appendOngoingFilter
+  ]
+
+reportOngoing :: Action
+reportOngoing =
+  Action
+    { actionName = "reportOngoing",
+      actionFunc = modifyEditorCursorS $ \ec -> do
+        saveCurrentSmosFile
+        now <- gets smosStateNow
+        zone <- gets smosStateTimeZone
+        dc <- asks $ reportSettingDirectorySettings . configReportSettings
+        narc <- liftIO $ produceOngoingReportCursor zone now Nothing HideArchive DontPrint dc
+        pure $
+          ec
+            { editorCursorSelection = ReportSelected,
+              editorCursorReportCursor = Just $ ReportOngoing narc
+            },
+      actionDescription = "Ongoing report"
+    }
+
+prevOngoing :: Action
+prevOngoing =
+  Action
+    { actionName = "prevOngoing",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorPrev,
+      actionDescription = "Select the previous entry in the ongoing report"
+    }
+
+nextOngoing :: Action
+nextOngoing =
+  Action
+    { actionName = "nextOngoing",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorNext,
+      actionDescription = "Select the next entry in the ongoing report"
+    }
+
+firstOngoing :: Action
+firstOngoing =
+  Action
+    { actionName = "firstOngoing",
+      actionFunc = modifyOngoingReportCursor ongoingReportCursorFirst,
+      actionDescription = "Select the first entry in the ongoing report"
+    }
+
+lastOngoing :: Action
+lastOngoing =
+  Action
+    { actionName = "lastOngoing",
+      actionFunc = modifyOngoingReportCursor ongoingReportCursorLast,
+      actionDescription = "Select the last entry in the ongoing report"
+    }
+
+enterOngoingFile :: Action
+enterOngoingFile =
+  Action
+    { actionName = "enterOngoingFile",
+      actionFunc = do
+        ss <- get
+        case editorCursorReportCursor $ smosStateCursor ss of
+          Just rc -> case rc of
+            ReportOngoing wrc -> do
+              dc <- asks $ reportSettingDirectorySettings . configReportSettings
+              wd <- liftIO $ resolveDirWorkflowDir dc
+              case ongoingReportCursorBuildSmosFileCursor wd wrc of
+                Nothing -> pure ()
+                Just (fp, sfc) -> void $ switchToCursor fp (Just sfc)
+            _ -> pure ()
+          Nothing -> pure (),
+      actionDescription = "Enter the currently selected ongoing entry"
+    }
+
+insertOngoingFilter :: ActionUsing Char
+insertOngoingFilter =
+  ActionUsing
+    { actionUsingName = "insertOngoingFilter",
+      actionUsingDescription = "Insert a character into the filter bar",
+      actionUsingFunc = \a -> modifyOngoingReportCursorM $ ongoingReportCursorInsert a
+    }
+
+appendOngoingFilter :: ActionUsing Char
+appendOngoingFilter =
+  ActionUsing
+    { actionUsingName = "appendOngoingFilter",
+      actionUsingDescription = "Append a character onto the filter bar",
+      actionUsingFunc = \a -> modifyOngoingReportCursorM $ ongoingReportCursorAppend a
+    }
+
+removeOngoingFilter :: Action
+removeOngoingFilter =
+  Action
+    { actionName = "removeOngoingFilter",
+      actionDescription = "Remove the character in filter bar before cursor",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorRemove
+    }
+
+deleteOngoingFilter :: Action
+deleteOngoingFilter =
+  Action
+    { actionName = "deleteOngoingFilter",
+      actionDescription = "Remove the character in filter bar under cursor",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorDelete
+    }
+
+selectOngoingReport :: Action
+selectOngoingReport =
+  Action
+    { actionName = "selectOngoingReport",
+      actionDescription = "Select the ongoing report",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorSelectReport
+    }
+
+selectOngoingFilter :: Action
+selectOngoingFilter =
+  Action
+    { actionName = "selectOngoingFilter",
+      actionDescription = "Select the ongoing filter bar",
+      actionFunc = modifyOngoingReportCursorM ongoingReportCursorSelectFilter
+    }

smos/src/Smos/Actions/Report/Work.hs

@@ -74,7 +74,10 @@ reportWork =
 
         wrc <- liftIO $ produceWorkReportCursor HideArchive DontPrint ds ctx
         -- If there are no contexts, we don't care about the entries without context
-        let wrc' = if null (workReportSettingContexts wc) then wrc {workReportCursorEntriesWithoutContext = emptyEntryReportCursor} else wrc
+        let wrc' =
+              if null (workReportSettingContexts wc)
+                then wrc {workReportCursorEntriesWithoutContext = emptyEntryReportCursor}
+                else wrc
         pure $
           ec
             { editorCursorSelection = ReportSelected,
@@ -144,6 +147,7 @@ enterWorkFile =
                         erc = foldKeyValueCursor (\_ x -> x) (\_ x -> x) kvc
                      in switchToSelectedInEntryReportCursor wd erc
                 DeadlinesSelected -> switchToSelectedInEntryReportCursor wd (timestampsReportCursorEntryReportCursor (workReportCursorDeadlinesCursor wrc))
+                OngoingSelected -> switchToSelectedInEntryReportCursor wd (ongoingReportCursorEntryReportCursor (workReportCursorOngoingEntries wrc))
                 WaitingSelected -> switchToSelectedInEntryReportCursor wd (waitingReportCursorEntryReportCursor (workReportCursorOverdueWaiting wrc))
                 StuckSelected -> case stuckReportCursorSelectedFile (workReportCursorOverdueStuck wrc) of
                   Nothing -> pure ()

smos/src/Smos/Actions/Utils.hs

@@ -26,6 +26,7 @@ module Smos.Actions.Utils
     module Smos.Cursor.Properties,
     module Smos.Cursor.Report.Next,
     module Smos.Cursor.Report.Waiting,
+    module Smos.Cursor.Report.Ongoing,
     module Smos.Cursor.Report.Timestamps,
     module Smos.Cursor.Report.Stuck,
     module Smos.Cursor.Report.Work,
@@ -48,6 +49,7 @@ import Smos.Cursor.Header
 import Smos.Cursor.Logbook
 import Smos.Cursor.Properties
 import Smos.Cursor.Report.Next
+import Smos.Cursor.Report.Ongoing
 import Smos.Cursor.Report.Stuck
 import Smos.Cursor.Report.Timestamps
 import Smos.Cursor.Report.Waiting
@@ -353,6 +355,20 @@ modifyWaitingReportCursorS func =
     ReportWaiting narc -> ReportWaiting <$> func narc
     _ -> pure rc
 
+modifyOngoingReportCursorM ::
+  (OngoingReportCursor -> Maybe OngoingReportCursor) -> SmosM ()
+modifyOngoingReportCursorM func = modifyOngoingReportCursor $ \hc -> fromMaybe hc $ func hc
+
+modifyOngoingReportCursor :: (OngoingReportCursor -> OngoingReportCursor) -> SmosM ()
+modifyOngoingReportCursor func = modifyOngoingReportCursorS $ pure . func
+
+modifyOngoingReportCursorS ::
+  (OngoingReportCursor -> SmosM OngoingReportCursor) -> SmosM ()
+modifyOngoingReportCursorS func =
+  modifyReportCursorS $ \rc -> case rc of
+    ReportOngoing narc -> ReportOngoing <$> func narc
+    _ -> pure rc
+
 modifyTimestampsReportCursorM ::
   (TimestampsReportCursor -> Maybe TimestampsReportCursor) -> SmosM ()
 modifyTimestampsReportCursorM func = modifyTimestampsReportCursor $ \hc -> fromMaybe hc $ func hc

smos/src/Smos/Activation.hs

@@ -21,6 +21,7 @@ import Smos.Cursor.Entry
 import Smos.Cursor.FileBrowser
 import Smos.Cursor.Report.Entry
 import Smos.Cursor.Report.Next
+import Smos.Cursor.Report.Ongoing
 import Smos.Cursor.Report.Timestamps
 import Smos.Cursor.Report.Waiting
 import Smos.Cursor.Report.Work
@@ -87,6 +88,15 @@ currentKeyMappings KeyMap {..} EditorCursor {..} =
                             case entryReportCursorSelection waitingReportCursorEntryReportCursor of
                               EntryReportSelected -> waitingReportMatchers
                               EntryReportFilterSelected -> waitingReportSearchMatchers
+                  ReportOngoing OngoingReportCursor {..} ->
+                    let OngoingReportKeyMap {..} = reportsKeymapOngoingReportKeyMap
+                        OngoingReportKeyMap _ _ _ = reportsKeymapOngoingReportKeyMap
+                        ongoingReportAnys = map ((,) AnyMatcher) ongoingReportAnyMatchers
+                     in (++ ongoingReportAnys) $
+                          map ((,) SpecificMatcher) $
+                            case entryReportCursorSelection ongoingReportCursorEntryReportCursor of
+                              EntryReportSelected -> ongoingReportMatchers
+                              EntryReportFilterSelected -> ongoingReportSearchMatchers
                   ReportTimestamps TimestampsReportCursor {..} ->
                     let TimestampsReportKeyMap {..} = reportsKeymapTimestampsReportKeyMap
                         TimestampsReportKeyMap _ _ _ = reportsKeymapTimestampsReportKeyMap

smos/src/Smos/App.hs

@@ -15,6 +15,7 @@ import qualified Data.List.NonEmpty as NE
 import Data.Sequence (Seq (..), (|>))
 import qualified Data.Sequence as Seq
 import Data.Time
+import Data.Time.Zones
 import qualified Graphics.Vty as Vty
 import Path
 import Smos.Actions.File
@@ -89,12 +90,12 @@ keyMapFunc s e km = handleRaw $ currentKeyMappings km $ smosStateCursor s
           case se of
             SmosUpdateTime ->
               EventActivated $ do
-                now <- liftIO getZonedTime
+                now <- liftIO getCurrentTime
                 modify
                   ( \s_ ->
                       s_
-                        { smosStateTime = now,
+                        { smosStateNow = now,
-                          smosStateCursor = editorCursorUpdateTime now $ smosStateCursor s_
+                          smosStateCursor = editorCursorUpdateTime (smosStateTimeZone s_) now $ smosStateCursor s_
                         }
                   )
             SmosSaveFile -> EventActivated saveCurrentSmosFile
@@ -125,13 +126,15 @@ buildInitialState p = do
     Just errOrEC -> case errOrEC of
       Left err -> liftIO $ die err
       Right ec -> do
-        zt <- liftIO getZonedTime
+        zone <- liftIO loadLocalTZ
-        pure $ initStateWithCursor zt ec
+        now <- liftIO getCurrentTime
+        pure $ initStateWithCursor zone now ec
 
-initStateWithCursor :: ZonedTime -> EditorCursor -> SmosState
+initStateWithCursor :: TZ -> UTCTime -> EditorCursor -> SmosState
-initStateWithCursor zt ec =
+initStateWithCursor zone now ec =
   SmosState
-    { smosStateTime = zt,
+    { smosStateNow = now,
+      smosStateTimeZone = zone,
       smosStateCursor = ec,
       smosStateKeyHistory = Empty,
       smosStateAsyncs = [],

smos/src/Smos/Config.hs

@@ -19,6 +19,7 @@ module Smos.Config
     ReportsKeyMap (..),
     NextActionReportKeyMap (..),
     WaitingReportKeyMap (..),
+    OngoingReportKeyMap (..),
     TimestampsReportKeyMap (..),
     StuckReportKeyMap (..),
     WorkReportKeyMap (..),

smos/src/Smos/Default.hs

@@ -310,6 +310,7 @@ defaultReportsKeyMap =
   ReportsKeyMap
     { reportsKeymapNextActionReportKeyMap = defaultNextActionReportKeyMap,
       reportsKeymapWaitingReportKeyMap = defaultWaitingReportKeyMap,
+      reportsKeymapOngoingReportKeyMap = defaultOngoingReportKeyMap,
       reportsKeymapTimestampsReportKeyMap = defaultTimestampsReportKeyMap,
       reportsKeymapStuckReportKeyMap = defaultStuckReportKeyMap,
       reportsKeymapWorkReportKeyMap = defaultWorkReportKeyMap,
@@ -374,6 +375,33 @@ defaultWaitingReportKeyMap =
       waitingReportAnyMatchers = listMatchers []
     }
 
+defaultOngoingReportKeyMap :: OngoingReportKeyMap
+defaultOngoingReportKeyMap =
+  OngoingReportKeyMap
+    { ongoingReportMatchers =
+        listMatchers
+          [ exactKey KUp prevOngoing,
+            exactChar 'k' prevOngoing,
+            exactKey KDown nextOngoing,
+            exactChar 'j' nextOngoing,
+            exactKey KHome firstOngoing,
+            exactString "gg" firstOngoing,
+            exactKey KEnd lastOngoing,
+            exactChar 'G' lastOngoing,
+            exactKey KEnter enterOngoingFile,
+            exactChar '/' selectOngoingFilter
+          ],
+      ongoingReportSearchMatchers =
+        listMatchers
+          [ anyChar insertOngoingFilter,
+            exactKey KEnter selectOngoingReport,
+            exactKey KEsc selectOngoingReport,
+            exactKey KBS removeOngoingFilter,
+            exactKey KDel deleteOngoingFilter
+          ],
+      ongoingReportAnyMatchers = listMatchers []
+    }
+
 defaultTimestampsReportKeyMap :: TimestampsReportKeyMap
 defaultTimestampsReportKeyMap =
   TimestampsReportKeyMap
@@ -494,6 +522,7 @@ defaultAnyKeyMap =
       -- Reports
       exactString "rn" reportNextActions,
       exactString "rw" reportWaiting,
+      exactString "ro" reportOngoing,
       exactString "ra" reportTimestamps,
       exactString "rs" reportStuck,
       exactString "rr" reportWork

smos/src/Smos/Draw.hs

@@ -42,6 +42,7 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time
+import Data.Time.Zones
 import Data.Version (showVersion)
 import Lens.Micro
 import Path
@@ -68,10 +69,9 @@ smosDraw workflowDir SmosConfig {..} SmosState {..} =
             drawEnvStuckThreshold = stuckReportSettingThreshold $ reportSettingStuckSettings configReportSettings,
             drawEnvWorkDrawEnv =
               let WorkReportSettings {..} = reportSettingWorkSettings configReportSettings
-               in DrawWorkEnv
+               in DrawWorkEnv {drawWorkEnvProjection = workReportSettingProjection},
-                    { drawWorkEnvProjection = workReportSettingProjection
+            drawEnvNow = smosStateNow,
-                    },
+            drawEnvTimeZone = smosStateTimeZone
-            drawEnvNow = smosStateTime
           }
    in [ vBox $
           concat
@@ -747,7 +747,7 @@ drawStateHistory :: StateHistory -> MDrawer
 drawStateHistory (StateHistory ls)
   | null ls = pure Nothing
   | otherwise = do
-      zt <- asks drawEnvNow
+      now <- asks drawEnvNow
       pure $
         Just $
           withAttr todoStateHistoryAttr $
@@ -758,7 +758,7 @@ drawStateHistory (StateHistory ls)
                     strWrap $
                       unwords
                         [ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" stateHistoryEntryTimestamp,
-                          "(" ++ prettyTimeAuto (zonedTimeToUTC zt) stateHistoryEntryTimestamp ++ ")"
+                          "(" ++ prettyTimeAuto now stateHistoryEntryTimestamp ++ ")"
                         ]
                   ]
 
@@ -823,7 +823,7 @@ drawLogbookTotal Nothing [] = pure Nothing
 drawLogbookTotal mopen lbes = do
   openTime <-
     forM mopen $ \open -> do
-      now <- asks $ zonedTimeToUTC . drawEnvNow
+      now <- asks drawEnvNow
       pure $ diffUTCTime now open
   let total = fromMaybe 0 openTime + foldl' (+) 0 (map logbookEntryDiffTime lbes)
   pure $
@@ -846,7 +846,7 @@ drawLogbookEntry lbe@LogbookEntry {..} = do
 
 drawLogOpen :: UTCTime -> Drawer
 drawLogOpen u = do
-  now <- asks $ zonedTimeToUTC . drawEnvNow
+  now <- asks drawEnvNow
   sw <- drawLogbookTimestamp u
   ew <- drawLogbookTimestamp now
   pure $
@@ -868,8 +868,8 @@ drawLogbookTimestamp utct = do
 
 drawUTCLocal :: UTCTime -> Drawer
 drawUTCLocal utct = do
-  tz <- asks $ zonedTimeZone . drawEnvNow
+  zone <- asks drawEnvTimeZone
-  let localTime = utcToLocalTime tz utct
+  let localTime = utcToLocalTimeTZ zone utct
   pure $ str (formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" localTime)
 
 drawActionName :: ActionName -> Widget n

smos/src/Smos/Draw/Base.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Smos.Draw.Base where
 
@@ -11,6 +12,7 @@ import Cursor.TextField
 import Data.List
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Time
+import Data.Time.Zones
 import Path
 import Smos.Data
 import Smos.Report.Projection
@@ -25,9 +27,13 @@ data DrawEnv = DrawEnv
   { drawEnvWaitingThreshold :: !Time,
     drawEnvStuckThreshold :: !Time,
     drawEnvWorkDrawEnv :: !DrawWorkEnv,
-    drawEnvNow :: !ZonedTime
+    drawEnvTimeZone :: !TZ,
+    drawEnvNow :: !UTCTime
   }
 
+drawEnvNowLocal :: DrawEnv -> LocalTime
+drawEnvNowLocal DrawEnv {..} = utcToLocalTimeTZ drawEnvTimeZone drawEnvNow
+
 data DrawWorkEnv = DrawWorkEnv
   { drawWorkEnvProjection :: !(NonEmpty Projection)
   }
@@ -176,7 +182,7 @@ drawDay d = str $ formatTimestampDay d
 
 drawDayPrettyRelative :: Day -> Drawer
 drawDayPrettyRelative d = do
-  today <- localDay . zonedTimeToLocalTime <$> asks drawEnvNow
+  today <- localDay <$> asks drawEnvNowLocal
   pure $ str $ prettyDayAuto today d
 
 drawLocalTimeWithPrettyRelative :: LocalTime -> Drawer
@@ -195,11 +201,12 @@ drawLocalTime lt = do
 
 drawLocalTimePrettyRelative :: LocalTime -> Drawer
 drawLocalTimePrettyRelative lt = do
-  zt@(ZonedTime _ tz) <- asks drawEnvNow
+  now <- asks drawEnvNow
+  zone <- asks drawEnvTimeZone
   pure $
     str $
-      prettyTimeAuto (zonedTimeToUTC zt) $
+      prettyTimeAuto now $
-        localTimeToUTC tz lt
+        localTimeToUTCTZ zone lt
 
 drawTime :: Time -> Widget n
 drawTime = txt . renderTime

smos/src/Smos/Draw/Report.hs

@@ -29,6 +29,7 @@ import Smos.Cursor.Report.Entry
 import Smos.Data
 import Smos.Draw.Base
 import Smos.Report.Filter
+import Smos.Report.Ongoing
 import Smos.Report.Projection
 import Smos.Report.Stuck
 import Smos.Report.Time
@@ -40,6 +41,7 @@ drawReportCursor :: Select -> ReportCursor -> Drawer
 drawReportCursor s = \case
   ReportNextActions narc -> drawNextActionReportCursor s narc
   ReportWaiting wrc -> drawWaitingReportCursor s wrc
+  ReportOngoing wrc -> drawOngoingReportCursor s wrc
   ReportTimestamps tsrc -> drawTimestampsReportCursor s tsrc
   ReportStuck src -> drawStuckReportCursor s src
   ReportWork wrc -> drawWorkReportCursor s wrc
@@ -75,7 +77,7 @@ drawWaitingReportCursor s WaitingReportCursor {..} = do
 
 drawWaitingEntryCursor :: Select -> EntryReportEntryCursor (UTCTime, Maybe Time) -> Drawer' [Widget ResourceName]
 drawWaitingEntryCursor s EntryReportEntryCursor {..} = do
-  now <- asks $ zonedTimeToUTC . drawEnvNow
+  now <- asks drawEnvNow
 
   let (ts, mThreshold) = entryReportEntryCursorVal
   defaultThreshold <- asks drawEnvWaitingThreshold
@@ -105,6 +107,15 @@ daysSinceWidget threshold now t = withAttr style $ str $ show i <> " days"
       | otherwise = waitingReportNoWait
     i = daysSince now t
 
+drawOngoingReportCursor :: Select -> OngoingReportCursor -> Drawer
+drawOngoingReportCursor s OngoingReportCursor {..} = do
+  ercw <-
+    drawEntryReportCursorSimple
+      drawOngoingEntryCursor
+      s
+      ongoingReportCursorEntryReportCursor
+  pure $ withHeading (str "Ongoing Report") $ padAll 1 ercw
+
 drawEntryReportCursorWithHeader ::
   [Widget ResourceName] -> (Select -> EntryReportEntryCursor a -> Drawer' [Widget ResourceName]) -> Select -> EntryReportCursor a -> Drawer
 drawEntryReportCursorWithHeader h go = drawEntryReportCursor $ \s mnec ->
@@ -171,14 +182,14 @@ drawEntryReportCursorFilter s EntryReportCursor {..} =
 
 drawTimestampsReportCursor :: Select -> TimestampsReportCursor -> Drawer
 drawTimestampsReportCursor s TimestampsReportCursor {..} = do
+  lt <- asks drawEnvNowLocal
   tsrw <-
     drawEntryReportCursor
       ( \s' mnec ->
           case mnec of
             Nothing -> pure $ txtWrap "Empty timestamps report"
             Just tsecs -> do
-              now <- asks drawEnvNow
+              ws <- mapM (drawTimestampReportLine s') $ makeTimestampReportLines lt tsecs
-              ws <- mapM (drawTimestampReportLine s') $ makeTimestampReportLines now tsecs
               pure $ tableWidget ws
       )
       s
@@ -193,9 +204,9 @@ data TimestampsReportLine
   | ReportNowLine !LocalTime
   | ReportHourLine !Int
 
-makeTimestampReportLines :: ZonedTime -> NonEmptyCursor (EntryReportEntryCursor TimestampsEntryCursor) -> [TimestampsReportLine]
+makeTimestampReportLines :: LocalTime -> NonEmptyCursor (EntryReportEntryCursor TimestampsEntryCursor) -> [TimestampsReportLine]
-makeTimestampReportLines now = foldNonEmptyCursor $ \befores current afters ->
+makeTimestampReportLines lt = foldNonEmptyCursor $ \befores current afters ->
-  insertReportNowLine now $ insertReportHourLines now $ concat [map ReportEntryLine befores, [ReportSelectedEntryLine current], map ReportEntryLine afters]
+  insertReportNowLine lt $ insertReportHourLines lt $ concat [map ReportEntryLine befores, [ReportSelectedEntryLine current], map ReportEntryLine afters]
 
 drawTimestampReportLine :: Select -> TimestampsReportLine -> Drawer' [Widget ResourceName]
 drawTimestampReportLine s = \case
@@ -224,47 +235,40 @@ drawTimestampReportLine s = \case
   where
     empty = str " "
 
-insertReportHourLines :: ZonedTime -> [TimestampsReportLine] -> [TimestampsReportLine]
+insertReportHourLines :: LocalTime -> [TimestampsReportLine] -> [TimestampsReportLine]
-insertReportHourLines now = go [8 .. 18]
+insertReportHourLines lt = go [8 .. 18]
   where
-    ZonedTime lt _ = now
     today = localDay lt
     go hs [] = map ReportHourLine hs
     go [] es = es
     go (h : hs) (e : es) =
-      let alt = timestampsReportLineLocalTime now e
+      let alt = timestampsReportLineLocalTime lt e
           hlt = hourLineLocalTime today h
        in if alt < hlt
             then e : go (h : hs) es
             else ReportHourLine h : go hs (e : es)
 
-timestampsReportLineLocalTime :: ZonedTime -> TimestampsReportLine -> LocalTime
+timestampsReportLineLocalTime :: LocalTime -> TimestampsReportLine -> LocalTime
-timestampsReportLineLocalTime now = \case
+timestampsReportLineLocalTime nowLocal = \case
   ReportSelectedEntryLine tec -> timestampLocalTime $ timestampsEntryCursorTimestamp $ entryReportEntryCursorVal tec
   ReportEntryLine tec -> timestampLocalTime $ timestampsEntryCursorTimestamp $ entryReportEntryCursorVal tec
   ReportNowLine lt -> lt
-  ReportHourLine h -> hourLineLocalTime (localDay $ zonedTimeToLocalTime now) h
+  ReportHourLine h -> hourLineLocalTime (localDay nowLocal) h
 
 hourLineLocalTime :: Day -> Int -> LocalTime
 hourLineLocalTime d h = LocalTime d (TimeOfDay h 0 0)
 
-insertReportNowLine :: ZonedTime -> [TimestampsReportLine] -> [TimestampsReportLine]
+insertReportNowLine :: LocalTime -> [TimestampsReportLine] -> [TimestampsReportLine]
-insertReportNowLine now = go
+insertReportNowLine lt = go
   where
-    nowL = ReportNowLine $ zonedTimeToLocalTime now
+    nowL = ReportNowLine lt
     go = \case
       [] -> [nowL]
       (x : xs) ->
-        if isBefore now x
+        if lt <= timestampsReportLineLocalTime lt x
           then nowL : x : xs
           else x : go xs
 
-isBefore :: ZonedTime -> TimestampsReportLine -> Bool
-isBefore now after =
-  let afterLT = timestampsReportLineLocalTime now after
-      nowUTC = zonedTimeToUTC now
-   in nowUTC <= localTimeToUTC (zonedTimeZone now) afterLT
-
 drawTimestampsEntryCursor :: Select -> EntryReportEntryCursor TimestampsEntryCursor -> Drawer' [Widget ResourceName]
 drawTimestampsEntryCursor s EntryReportEntryCursor {..} = do
   let sel = withVisibleSelected s . withSelPointer s
@@ -292,7 +296,7 @@ drawStuckReportCursor s StuckReportCursor {..} = do
 
 drawStuckReportEntry :: Select -> StuckReportEntry -> Drawer' [Widget ResourceName]
 drawStuckReportEntry s StuckReportEntry {..} = do
-  now <- asks $ zonedTimeToUTC . drawEnvNow
+  now <- asks drawEnvNow
   threshold <- asks drawEnvStuckThreshold
   let sel = withVisibleSelected s . withSelPointer s
   pure
@@ -307,7 +311,7 @@ drawStuckReportEntry s StuckReportEntry {..} = do
 
 drawWorkReportCursor :: Select -> WorkReportCursor -> Drawer
 drawWorkReportCursor s wrc@WorkReportCursor {..} = do
-  let WorkReportCursor _ _ _ _ _ _ _ _ _ = undefined
+  let WorkReportCursor _ _ _ _ _ _ _ _ _ _ = undefined
   DrawWorkEnv {..} <- asks drawEnvWorkDrawEnv
   let selectIf :: WorkReportCursorSelection -> Select
       selectIf sel =
@@ -321,6 +325,7 @@ drawWorkReportCursor s wrc@WorkReportCursor {..} = do
             [ withAttr workReportWarningAttr $ str ("WARNING: " <> title),
               w
             ]
+      titleSection :: String -> Drawer' (Widget ResourceName) -> Drawer' (Widget ResourceName)
       titleSection title mkW = do
         w <- mkW
         pure $
@@ -330,7 +335,9 @@ drawWorkReportCursor s wrc@WorkReportCursor {..} = do
             ]
   let sectionGens =
         concat
-          [ [ titleSection "Next meeting" $
+          [ -- Helpful for debugging:
+            -- [titleSection "Selection" $ pure $ str $ show workReportCursorSelection],
+            [ titleSection "Next meeting" $
                 drawNextMeetingEntryCursor (selectIf NextBeginSelected) erec
               | erec <- maybeToList workReportCursorNextBeginCursor
             ],
@@ -358,7 +365,14 @@ drawWorkReportCursor s wrc@WorkReportCursor {..} = do
                in verticalMapCursorWidgetM go goKVC go mc
               | mc <- maybeToList workReportCursorCheckViolations
             ],
-            [ titleSection "Deadlines" $
+            [ titleSection "Ongoing" $
+                drawEntryReportCursorTableSimple
+                  drawOngoingEntryCursor
+                  (selectIf OngoingSelected)
+                  (ongoingReportCursorEntryReportCursor workReportCursorOngoingEntries)
+              | not $ workReportOngoingEmpty wrc
+            ],
+            [ titleSection "Upcoming" $
                 drawEntryReportCursorTableSimple
                   drawTimestampsEntryCursor
                   (selectIf DeadlinesSelected)
@@ -434,6 +448,35 @@ drawWorkReportResultEntryCursor s erc = do
   let sel = withVisibleSelected s
   map sel . toList <$> drawProjecteeNE s (projectEntryReportEntryCursor drawWorkEnvProjection erc)
 
+drawOngoingEntryCursor ::
+  Select ->
+  EntryReportEntryCursor BeginEnd ->
+  Drawer' [Widget ResourceName]
+drawOngoingEntryCursor s EntryReportEntryCursor {..} = do
+  let sel = withVisibleSelected s
+      e = forestCursorCurrent entryReportEntryCursorForestCursor
+      (mBegin, mEnd) = renderBeginEnd entryReportEntryCursorVal
+  let beginAttr = timestampNameSpecificAttr "BEGIN"
+  let endAttr = timestampNameSpecificAttr "END"
+  brtsw <- mapM drawTimestampPrettyRelative mBegin
+  ertsw <- mapM drawTimestampPrettyRelative mEnd
+  nowLocal <- asks drawEnvNowLocal
+  let percentageColumn = case (,) <$> mBegin <*> mEnd of
+        Nothing -> str " "
+        Just (begin, end) -> str $ beginEndPercentageString nowLocal begin end
+  pure $
+    map
+      sel
+      [ str $ fromRelFile entryReportEntryCursorFilePath,
+        withSelPointer s $ drawHeader $ entryHeader e,
+        withAttr beginAttr $ maybe (str " ") drawTimestamp mBegin,
+        withAttr agendaReportRelativeAttr $ fromMaybe (str " ") brtsw,
+        str $ if isJust mBegin && isJust mEnd then "-" else " ",
+        withAttr endAttr $ maybe (str " ") drawTimestamp mEnd,
+        withAttr agendaReportRelativeAttr $ fromMaybe (str " ") ertsw,
+        percentageColumn
+      ]
+
 drawProjectionHeaderNE :: NonEmpty Projection -> NonEmpty (Widget n)
 drawProjectionHeaderNE = NE.map drawProjectionHeader
 

smos/src/Smos/OptParse.hs

@@ -106,67 +106,69 @@ combineBrowserKeyMap bkm (Just bkc) =
 combineReportsKeymap :: ReportsKeyMap -> Maybe ReportsKeyConfigs -> Comb ReportsKeyMap
 combineReportsKeymap rkm Nothing = pure rkm
 combineReportsKeymap rkm (Just rkc) =
-  let ReportsKeyMap _ _ _ _ _ _ = undefined
+  ReportsKeyMap
-   in ReportsKeyMap
+    <$> combineNextActionReportKeyMap (reportsKeymapNextActionReportKeyMap rkm) (nextActionReportKeyConfigs rkc)
-        <$> combineNextActionReportKeyMap (reportsKeymapNextActionReportKeyMap rkm) (nextActionReportKeyConfigs rkc)
+    <*> combineWaitingReportKeyMap (reportsKeymapWaitingReportKeyMap rkm) (waitingReportKeyConfigs rkc)
-        <*> combineWaitingReportKeyMap (reportsKeymapWaitingReportKeyMap rkm) (waitingReportKeyConfigs rkc)
+    <*> combineOngoingReportKeyMap (reportsKeymapOngoingReportKeyMap rkm) (ongoingReportKeyConfigs rkc)
-        <*> combineTimestampsReportKeyMap (reportsKeymapTimestampsReportKeyMap rkm) (timestampsReportKeyConfigs rkc)
+    <*> combineTimestampsReportKeyMap (reportsKeymapTimestampsReportKeyMap rkm) (timestampsReportKeyConfigs rkc)
-        <*> combineStuckReportKeyMap (reportsKeymapStuckReportKeyMap rkm) (stuckReportKeyConfigs rkc)
+    <*> combineStuckReportKeyMap (reportsKeymapStuckReportKeyMap rkm) (stuckReportKeyConfigs rkc)
-        <*> combineWorkReportKeyMap (reportsKeymapWorkReportKeyMap rkm) (workReportKeyConfigs rkc)
+    <*> combineWorkReportKeyMap (reportsKeymapWorkReportKeyMap rkm) (workReportKeyConfigs rkc)
-        <*> combineKeyMappings (reportsKeymapAnyMatchers rkm) (anyReportKeyConfigs rkc)
+    <*> combineKeyMappings (reportsKeymapAnyMatchers rkm) (anyReportKeyConfigs rkc)
 
 combineNextActionReportKeyMap :: NextActionReportKeyMap -> Maybe NextActionReportKeyConfigs -> Comb NextActionReportKeyMap
 combineNextActionReportKeyMap narkm Nothing = pure narkm
 combineNextActionReportKeyMap narkm (Just narkc) =
-  let NextActionReportKeyMap _ _ _ = undefined
+  NextActionReportKeyMap
-   in NextActionReportKeyMap
+    <$> combineKeyMappings (nextActionReportMatchers narkm) (nextActionReportNormalKeyConfigs narkc)
-        <$> combineKeyMappings (nextActionReportMatchers narkm) (nextActionReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (nextActionReportSearchMatchers narkm) (nextActionReportSearchKeyConfigs narkc)
-        <*> combineKeyMappings (nextActionReportSearchMatchers narkm) (nextActionReportSearchKeyConfigs narkc)
+    <*> combineKeyMappings (nextActionReportAnyMatchers narkm) (nextActionReportAnyKeyConfigs narkc)
-        <*> combineKeyMappings (nextActionReportAnyMatchers narkm) (nextActionReportAnyKeyConfigs narkc)
 
 combineWaitingReportKeyMap :: WaitingReportKeyMap -> Maybe WaitingReportKeyConfigs -> Comb WaitingReportKeyMap
 combineWaitingReportKeyMap narkm Nothing = pure narkm
 combineWaitingReportKeyMap narkm (Just narkc) =
-  let WaitingReportKeyMap _ _ _ = undefined
+  WaitingReportKeyMap
-   in WaitingReportKeyMap
+    <$> combineKeyMappings (waitingReportMatchers narkm) (waitingReportNormalKeyConfigs narkc)
-        <$> combineKeyMappings (waitingReportMatchers narkm) (waitingReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (waitingReportSearchMatchers narkm) (waitingReportSearchKeyConfigs narkc)
-        <*> combineKeyMappings (waitingReportSearchMatchers narkm) (waitingReportSearchKeyConfigs narkc)
+    <*> combineKeyMappings (waitingReportAnyMatchers narkm) (waitingReportAnyKeyConfigs narkc)
-        <*> combineKeyMappings (waitingReportAnyMatchers narkm) (waitingReportAnyKeyConfigs narkc)
+
+combineOngoingReportKeyMap :: OngoingReportKeyMap -> Maybe OngoingReportKeyConfigs -> Comb OngoingReportKeyMap
+combineOngoingReportKeyMap narkm Nothing = pure narkm
+combineOngoingReportKeyMap narkm (Just narkc) =
+  OngoingReportKeyMap
+    <$> combineKeyMappings (ongoingReportMatchers narkm) (ongoingReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (ongoingReportSearchMatchers narkm) (ongoingReportSearchKeyConfigs narkc)
+    <*> combineKeyMappings (ongoingReportAnyMatchers narkm) (ongoingReportAnyKeyConfigs narkc)
 
 combineTimestampsReportKeyMap :: TimestampsReportKeyMap -> Maybe TimestampsReportKeyConfigs -> Comb TimestampsReportKeyMap
 combineTimestampsReportKeyMap narkm Nothing = pure narkm
 combineTimestampsReportKeyMap narkm (Just narkc) =
-  let TimestampsReportKeyMap _ _ _ = undefined
+  TimestampsReportKeyMap
-   in TimestampsReportKeyMap
+    <$> combineKeyMappings (timestampsReportMatchers narkm) (timestampsReportNormalKeyConfigs narkc)
-        <$> combineKeyMappings (timestampsReportMatchers narkm) (timestampsReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (timestampsReportSearchMatchers narkm) (timestampsReportSearchKeyConfigs narkc)
-        <*> combineKeyMappings (timestampsReportSearchMatchers narkm) (timestampsReportSearchKeyConfigs narkc)
+    <*> combineKeyMappings (timestampsReportAnyMatchers narkm) (timestampsReportAnyKeyConfigs narkc)
-        <*> combineKeyMappings (timestampsReportAnyMatchers narkm) (timestampsReportAnyKeyConfigs narkc)
 
 combineStuckReportKeyMap :: StuckReportKeyMap -> Maybe StuckReportKeyConfigs -> Comb StuckReportKeyMap
 combineStuckReportKeyMap narkm Nothing = pure narkm
 combineStuckReportKeyMap narkm (Just narkc) =
-  let StuckReportKeyMap _ _ = undefined
+  StuckReportKeyMap
-   in StuckReportKeyMap
+    <$> combineKeyMappings (stuckReportMatchers narkm) (stuckReportNormalKeyConfigs narkc)
-        <$> combineKeyMappings (stuckReportMatchers narkm) (stuckReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (stuckReportAnyMatchers narkm) (stuckReportAnyKeyConfigs narkc)
-        <*> combineKeyMappings (stuckReportAnyMatchers narkm) (stuckReportAnyKeyConfigs narkc)
 
 combineWorkReportKeyMap :: WorkReportKeyMap -> Maybe WorkReportKeyConfigs -> Comb WorkReportKeyMap
 combineWorkReportKeyMap narkm Nothing = pure narkm
 combineWorkReportKeyMap narkm (Just narkc) =
-  let WorkReportKeyMap _ _ _ = undefined
+  WorkReportKeyMap
-   in WorkReportKeyMap
+    <$> combineKeyMappings (workReportMatchers narkm) (workReportNormalKeyConfigs narkc)
-        <$> combineKeyMappings (workReportMatchers narkm) (workReportNormalKeyConfigs narkc)
+    <*> combineKeyMappings (workReportSearchMatchers narkm) (workReportSearchKeyConfigs narkc)
-        <*> combineKeyMappings (workReportSearchMatchers narkm) (workReportSearchKeyConfigs narkc)
+    <*> combineKeyMappings (workReportAnyMatchers narkm) (workReportAnyKeyConfigs narkc)
-        <*> combineKeyMappings (workReportAnyMatchers narkm) (workReportAnyKeyConfigs narkc)
 
 combineHelpKeymap :: HelpKeyMap -> Maybe HelpKeyConfigs -> Comb HelpKeyMap
 combineHelpKeymap hkm Nothing = pure hkm
 combineHelpKeymap hkm (Just hkc) =
-  let HelpKeyMap _ _ _ = undefined
+  HelpKeyMap
-   in HelpKeyMap
+    <$> combineKeyMappings (helpKeyMapHelpMatchers hkm) (helpHelpKeyConfigs hkc)
-        <$> combineKeyMappings (helpKeyMapHelpMatchers hkm) (helpHelpKeyConfigs hkc)
+    <*> combineKeyMappings (helpKeyMapSearchMatchers hkm) (helpSearchKeyConfigs hkc)
-        <*> combineKeyMappings (helpKeyMapSearchMatchers hkm) (helpSearchKeyConfigs hkc)
+    <*> combineKeyMappings (helpKeyMapAnyMatchers hkm) (helpAnyKeyConfigs hkc)
-        <*> combineKeyMappings (helpKeyMapAnyMatchers hkm) (helpAnyKeyConfigs hkc)
 
 combineKeyMappings :: KeyMappings -> Maybe KeyConfigs -> Comb KeyMappings
 combineKeyMappings kms Nothing = pure kms

smos/src/Smos/OptParse/Types.hs

@@ -51,10 +51,14 @@ instance HasCodec Configuration where
   codec =
     object "Configuration" $
       Configuration
-        <$> objectCodec .= confReportConf
+        <$> objectCodec
-        <*> optionalFieldOrNull "keys" "Keybindings" .= confKeybindingsConf
+          .= confReportConf
-        <*> optionalFieldOrNull "explainer-mode" "Turn on explainer mode where the user can see what is happening" .= confExplainerMode
+        <*> optionalFieldOrNull "keys" "Keybindings"
-        <*> optionalFieldOrNull "sandbox-mode" "Turn on sandbox mode where smos cannot affect any files other than the workflow files" .= confSandboxMode
+          .= confKeybindingsConf
+        <*> optionalFieldOrNull "explainer-mode" "Turn on explainer mode where the user can see what is happening"
+          .= confExplainerMode
+        <*> optionalFieldOrNull "sandbox-mode" "Turn on sandbox mode where smos cannot affect any files other than the workflow files"
+          .= confSandboxMode
 
 backToConfiguration :: SmosConfig -> Configuration
 backToConfiguration SmosConfig {..} =
@@ -83,12 +87,18 @@ instance HasCodec KeybindingsConfiguration where
   codec =
     object "KeybindingsConfiguration" $
       KeybindingsConfiguration
-        <$> optionalFieldOrNull "reset" "Whether to reset all keybindings. Set this to false to add keys, set this to true to replace keys." .= confReset
+        <$> optionalFieldOrNull "reset" "Whether to reset all keybindings. Set this to false to add keys, set this to true to replace keys."
-        <*> optionalFieldOrNull "file" "Keybindings for the file context" .= confFileKeyConfig
+          .= confReset
-        <*> optionalFieldOrNull "browser" "Keybindings for the file browser context" .= confBrowserKeyConfig
+        <*> optionalFieldOrNull "file" "Keybindings for the file context"
-        <*> optionalFieldOrNull "reports" "Keybindings for the reports context" .= confReportsKeyConfig
+          .= confFileKeyConfig
-        <*> optionalFieldOrNull "help" "Keybindings for the help context" .= confHelpKeyConfig
+        <*> optionalFieldOrNull "browser" "Keybindings for the file browser context"
-        <*> optionalFieldOrNull "any" "Keybindings for any context" .= confAnyKeyConfig
+          .= confBrowserKeyConfig
+        <*> optionalFieldOrNull "reports" "Keybindings for the reports context"
+          .= confReportsKeyConfig
+        <*> optionalFieldOrNull "help" "Keybindings for the help context"
+          .= confHelpKeyConfig
+        <*> optionalFieldOrNull "any" "Keybindings for any context"
+          .= confAnyKeyConfig
 
 backToKeybindingsConfiguration :: KeyMap -> KeybindingsConfiguration
 backToKeybindingsConfiguration KeyMap {..} =
@@ -123,16 +133,26 @@ instance HasCodec FileKeyConfigs where
   codec =
     object "FileKeyConfigs" $
       FileKeyConfigs
-        <$> optionalFieldOrNull "empty" "Keybindings for when the file is empty" .= emptyKeyConfigs
+        <$> optionalFieldOrNull "empty" "Keybindings for when the file is empty"
-        <*> optionalFieldOrNull "entry" "Keybindings for when an entry is selected" .= entryKeyConfigs
+          .= emptyKeyConfigs
-        <*> optionalFieldOrNull "header" "Keybindings for when an header is selected" .= headerKeyConfigs
+        <*> optionalFieldOrNull "entry" "Keybindings for when an entry is selected"
-        <*> optionalFieldOrNull "contents" "Keybindings for when an contents is selected" .= contentsKeyConfigs
+          .= entryKeyConfigs
-        <*> optionalFieldOrNull "timestamps" "Keybindings for when a timestamps are selected" .= timestampsKeyConfigs
+        <*> optionalFieldOrNull "header" "Keybindings for when an header is selected"
-        <*> optionalFieldOrNull "properties" "Keybindings for when a properties are selected" .= propertiesKeyConfigs
+          .= headerKeyConfigs
-        <*> optionalFieldOrNull "state-history" "Keybindings for when a state history is selected" .= stateHistoryKeyConfigs
+        <*> optionalFieldOrNull "contents" "Keybindings for when an contents is selected"
-        <*> optionalFieldOrNull "tags" "Keybindings for when a tags are selected" .= tagsKeyConfigs
+          .= contentsKeyConfigs
-        <*> optionalFieldOrNull "logbook" "Keybindings for when a logbook is selected" .= logbookKeyConfigs
+        <*> optionalFieldOrNull "timestamps" "Keybindings for when a timestamps are selected"
-        <*> optionalFieldOrNull "any" "Keybindings that match in any file subcontext" .= anyKeyConfigs
+          .= timestampsKeyConfigs
+        <*> optionalFieldOrNull "properties" "Keybindings for when a properties are selected"
+          .= propertiesKeyConfigs
+        <*> optionalFieldOrNull "state-history" "Keybindings for when a state history is selected"
+          .= stateHistoryKeyConfigs
+        <*> optionalFieldOrNull "tags" "Keybindings for when a tags are selected"
+          .= tagsKeyConfigs
+        <*> optionalFieldOrNull "logbook" "Keybindings for when a logbook is selected"
+          .= logbookKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings that match in any file subcontext"
+          .= anyKeyConfigs
 
 backToFileKeyConfigs :: FileKeyMap -> FileKeyConfigs
 backToFileKeyConfigs FileKeyMap {..} =
@@ -166,11 +186,16 @@ instance HasCodec BrowserKeyConfigs where
   codec =
     object "BrowserKeyConfigs" $
       BrowserKeyConfigs
-        <$> optionalFieldOrNull "existent" "Keybindings for when an existing file or directory is selected" .= browserExistentKeyConfigs
+        <$> optionalFieldOrNull "existent" "Keybindings for when an existing file or directory is selected"
-        <*> optionalFieldOrNull "in-progress" "Keybindings for when an in-progress file or directory is selected" .= browserInProgressKeyConfigs
+          .= browserExistentKeyConfigs
-        <*> optionalFieldOrNull "empty" "Keybindings for when the directory being browsed is empty" .= browserEmptyKeyConfigs
+        <*> optionalFieldOrNull "in-progress" "Keybindings for when an in-progress file or directory is selected"
-        <*> optionalFieldOrNull "filter" "Keybindings for when file browser's filter bar is selected" .= browserFilterKeyConfigs
+          .= browserInProgressKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for any of the other file browser situations" .= browserAnyKeyConfigs
+        <*> optionalFieldOrNull "empty" "Keybindings for when the directory being browsed is empty"
+          .= browserEmptyKeyConfigs
+        <*> optionalFieldOrNull "filter" "Keybindings for when file browser's filter bar is selected"
+          .= browserFilterKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for any of the other file browser situations"
+          .= browserAnyKeyConfigs
 
 backToBrowserKeyConfigs :: BrowserKeyMap -> BrowserKeyConfigs
 backToBrowserKeyConfigs BrowserKeyMap {..} =
@@ -186,6 +211,7 @@ backToBrowserKeyConfigs BrowserKeyMap {..} =
 data ReportsKeyConfigs = ReportsKeyConfigs
   { nextActionReportKeyConfigs :: Maybe NextActionReportKeyConfigs,
     waitingReportKeyConfigs :: Maybe WaitingReportKeyConfigs,
+    ongoingReportKeyConfigs :: Maybe OngoingReportKeyConfigs,
     timestampsReportKeyConfigs :: Maybe TimestampsReportKeyConfigs,
     stuckReportKeyConfigs :: Maybe StuckReportKeyConfigs,
     workReportKeyConfigs :: Maybe WorkReportKeyConfigs,
@@ -200,19 +226,28 @@ instance HasCodec ReportsKeyConfigs where
   codec =
     object "ReportsKeyConfigs" $
       ReportsKeyConfigs
-        <$> optionalFieldOrNull "next-action" "Keybindings for the interactive next action report" .= nextActionReportKeyConfigs
+        <$> optionalFieldOrNull "next-action" "Keybindings for the interactive next action report"
-        <*> optionalFieldOrNull "waiting" "Keybindings for the interactive waiting report" .= waitingReportKeyConfigs
+          .= nextActionReportKeyConfigs
-        <*> optionalFieldOrNull "timestamps" "Keybindings for the interactive timestamps report" .= timestampsReportKeyConfigs
+        <*> optionalFieldOrNull "waiting" "Keybindings for the interactive waiting report"
-        <*> optionalFieldOrNull "stuck" "Keybindings for the interactive stuck projects report" .= stuckReportKeyConfigs
+          .= waitingReportKeyConfigs
-        <*> optionalFieldOrNull "work" "Keybindings for the interactive work report" .= workReportKeyConfigs
+        <*> optionalFieldOrNull "ongoing" "Keybindings for the interactive ongoing report"
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in any report" .= anyReportKeyConfigs
+          .= ongoingReportKeyConfigs
+        <*> optionalFieldOrNull "timestamps" "Keybindings for the interactive timestamps report"
+          .= timestampsReportKeyConfigs
+        <*> optionalFieldOrNull "stuck" "Keybindings for the interactive stuck projects report"
+          .= stuckReportKeyConfigs
+        <*> optionalFieldOrNull "work" "Keybindings for the interactive work report"
+          .= workReportKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in any report"
+          .= anyReportKeyConfigs
 
 backToReportsKeyConfig :: ReportsKeyMap -> ReportsKeyConfigs
 backToReportsKeyConfig ReportsKeyMap {..} =
-  let ReportsKeyMap _ _ _ _ _ _ = undefined
+  let ReportsKeyMap _ _ _ _ _ _ _ = undefined
    in ReportsKeyConfigs
         { nextActionReportKeyConfigs = Just $ backToNextActionReportKeyConfigs reportsKeymapNextActionReportKeyMap,
           waitingReportKeyConfigs = Just $ backToWaitingReportKeyConfigs reportsKeymapWaitingReportKeyMap,
+          ongoingReportKeyConfigs = Just $ backToOngoingReportKeyConfigs reportsKeymapOngoingReportKeyMap,
           timestampsReportKeyConfigs = Just $ backToTimestampsReportKeyConfigs reportsKeymapTimestampsReportKeyMap,
           stuckReportKeyConfigs = Just $ backToStuckReportKeyConfigs reportsKeymapStuckReportKeyMap,
           workReportKeyConfigs = Just $ backToWorkReportKeyConfigs reportsKeymapWorkReportKeyMap,
@@ -233,9 +268,12 @@ instance HasCodec NextActionReportKeyConfigs where
   codec =
     object "NextActionReportKeyConfigs" $
       NextActionReportKeyConfigs
-        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the next-action report" .= nextActionReportNormalKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the next-action report"
-        <*> optionalFieldOrNull "search" "Keybindings for the search in the next-action report" .= nextActionReportSearchKeyConfigs
+          .= nextActionReportNormalKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in the next-action report" .= nextActionReportAnyKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for the search in the next-action report"
+          .= nextActionReportSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the next-action report"
+          .= nextActionReportAnyKeyConfigs
 
 backToNextActionReportKeyConfigs :: NextActionReportKeyMap -> NextActionReportKeyConfigs
 backToNextActionReportKeyConfigs NextActionReportKeyMap {..} =
@@ -260,9 +298,12 @@ instance HasCodec WaitingReportKeyConfigs where
   codec =
     object "WaitingReportKeyConfigs" $
       WaitingReportKeyConfigs
-        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the waiting report" .= waitingReportNormalKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the waiting report"
-        <*> optionalFieldOrNull "search" "Keybindings for the search in the waiting report" .= waitingReportSearchKeyConfigs
+          .= waitingReportNormalKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in the waiting report" .= waitingReportAnyKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for the search in the waiting report"
+          .= waitingReportSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the waiting report"
+          .= waitingReportAnyKeyConfigs
 
 backToWaitingReportKeyConfigs :: WaitingReportKeyMap -> WaitingReportKeyConfigs
 backToWaitingReportKeyConfigs WaitingReportKeyMap {..} =
@@ -273,6 +314,36 @@ backToWaitingReportKeyConfigs WaitingReportKeyMap {..} =
           waitingReportAnyKeyConfigs = Just $ backToKeyConfigs waitingReportAnyMatchers
         }
 
+data OngoingReportKeyConfigs = OngoingReportKeyConfigs
+  { ongoingReportNormalKeyConfigs :: !(Maybe KeyConfigs),
+    ongoingReportSearchKeyConfigs :: !(Maybe KeyConfigs),
+    ongoingReportAnyKeyConfigs :: !(Maybe KeyConfigs)
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving (ToJSON, FromJSON) via (Autodocodec OngoingReportKeyConfigs)
+
+instance Validity OngoingReportKeyConfigs
+
+instance HasCodec OngoingReportKeyConfigs where
+  codec =
+    object "OngoingReportKeyConfigs" $
+      OngoingReportKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the ongoing report"
+          .= ongoingReportNormalKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for the search in the ongoing report"
+          .= ongoingReportSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the ongoing report"
+          .= ongoingReportAnyKeyConfigs
+
+backToOngoingReportKeyConfigs :: OngoingReportKeyMap -> OngoingReportKeyConfigs
+backToOngoingReportKeyConfigs OngoingReportKeyMap {..} =
+  let OngoingReportKeyMap _ _ _ = undefined
+   in OngoingReportKeyConfigs
+        { ongoingReportNormalKeyConfigs = Just $ backToKeyConfigs ongoingReportMatchers,
+          ongoingReportSearchKeyConfigs = Just $ backToKeyConfigs ongoingReportSearchMatchers,
+          ongoingReportAnyKeyConfigs = Just $ backToKeyConfigs ongoingReportAnyMatchers
+        }
+
 data TimestampsReportKeyConfigs = TimestampsReportKeyConfigs
   { timestampsReportNormalKeyConfigs :: !(Maybe KeyConfigs),
     timestampsReportSearchKeyConfigs :: !(Maybe KeyConfigs),
@@ -287,9 +358,12 @@ instance HasCodec TimestampsReportKeyConfigs where
   codec =
     object "TimestampsReportKeyConfigs" $
       TimestampsReportKeyConfigs
-        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the timestamps report" .= timestampsReportNormalKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the timestamps report"
-        <*> optionalFieldOrNull "search" "Keybindings for the search in the timestamps report" .= timestampsReportSearchKeyConfigs
+          .= timestampsReportNormalKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in the timestamps report" .= timestampsReportAnyKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for the search in the timestamps report"
+          .= timestampsReportSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the timestamps report"
+          .= timestampsReportAnyKeyConfigs
 
 backToTimestampsReportKeyConfigs :: TimestampsReportKeyMap -> TimestampsReportKeyConfigs
 backToTimestampsReportKeyConfigs TimestampsReportKeyMap {..} =
@@ -313,8 +387,10 @@ instance HasCodec StuckReportKeyConfigs where
   codec =
     object "StuckReportKeyConfigs" $
       StuckReportKeyConfigs
-        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the stuck report" .= stuckReportNormalKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the stuck report"
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in the stuck report" .= stuckReportAnyKeyConfigs
+          .= stuckReportNormalKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the stuck report"
+          .= stuckReportAnyKeyConfigs
 
 backToStuckReportKeyConfigs :: StuckReportKeyMap -> StuckReportKeyConfigs
 backToStuckReportKeyConfigs StuckReportKeyMap {..} =
@@ -338,9 +414,12 @@ instance HasCodec WorkReportKeyConfigs where
   codec =
     object "WorkReportKeyConfigs" $
       WorkReportKeyConfigs
-        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the work report" .= workReportNormalKeyConfigs
+        <$> optionalFieldOrNull "normal" "Keybindings for interacting with the work report"
-        <*> optionalFieldOrNull "search" "Keybindings for the search in the work report" .= workReportSearchKeyConfigs
+          .= workReportNormalKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for at any point in the work report" .= workReportAnyKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for the search in the work report"
+          .= workReportSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any point in the work report"
+          .= workReportAnyKeyConfigs
 
 backToWorkReportKeyConfigs :: WorkReportKeyMap -> WorkReportKeyConfigs
 backToWorkReportKeyConfigs WorkReportKeyMap {..} =
@@ -365,9 +444,12 @@ instance HasCodec HelpKeyConfigs where
   codec =
     object "HelpKeyConfigs" $
       HelpKeyConfigs
-        <$> optionalFieldOrNull "help" "Keybindings for when in the help screen" .= helpHelpKeyConfigs
+        <$> optionalFieldOrNull "help" "Keybindings for when in the help screen"
-        <*> optionalFieldOrNull "search" "Keybindings for when the search bar is selected within the help screen" .= helpSearchKeyConfigs
+          .= helpHelpKeyConfigs
-        <*> optionalFieldOrNull "any" "Keybindings for at any time in the help screen" .= helpAnyKeyConfigs
+        <*> optionalFieldOrNull "search" "Keybindings for when the search bar is selected within the help screen"
+          .= helpSearchKeyConfigs
+        <*> optionalFieldOrNull "any" "Keybindings for at any time in the help screen"
+          .= helpAnyKeyConfigs
 
 backToHelpKeyConfigs :: HelpKeyMap -> HelpKeyConfigs
 backToHelpKeyConfigs HelpKeyMap {..} =
@@ -405,8 +487,10 @@ instance HasCodec KeyConfig where
     named "KeyConfig" $
       object "KeyConfig" $
         KeyConfig
-          <$> requiredField "key" "The key to match" .= keyConfigMatcher
+          <$> requiredField "key" "The key to match"
-          <*> requiredField "action" "The name of the action to perform when the key is matched" .= keyConfigAction
+            .= keyConfigMatcher
+          <*> requiredField "action" "The name of the action to perform when the key is matched"
+            .= keyConfigAction
 
 backToKeyConfig :: KeyMapping -> KeyConfig
 backToKeyConfig km =

smos/src/Smos/Types.hs

@@ -38,6 +38,7 @@ import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time
+import Data.Time.Zones
 import Data.Validity
 import GHC.Generics (Generic)
 import Lens.Micro
@@ -46,6 +47,7 @@ import Smos.Cursor.Entry
 import Smos.Cursor.FileBrowser
 import Smos.Cursor.Report.Entry
 import Smos.Cursor.Report.Next
+import Smos.Cursor.Report.Ongoing
 import Smos.Cursor.Report.Stuck
 import Smos.Cursor.Report.Timestamps
 import Smos.Cursor.Report.Waiting
@@ -220,6 +222,7 @@ instance Monoid BrowserKeyMap where
 data ReportsKeyMap = ReportsKeyMap
   { reportsKeymapNextActionReportKeyMap :: !NextActionReportKeyMap,
     reportsKeymapWaitingReportKeyMap :: !WaitingReportKeyMap,
+    reportsKeymapOngoingReportKeyMap :: !OngoingReportKeyMap,
     reportsKeymapTimestampsReportKeyMap :: !TimestampsReportKeyMap,
     reportsKeymapStuckReportKeyMap :: !StuckReportKeyMap,
     reportsKeymapWorkReportKeyMap :: !WorkReportKeyMap,
@@ -229,12 +232,14 @@ data ReportsKeyMap = ReportsKeyMap
 
 instance Semigroup ReportsKeyMap where
   rkm1 <> rkm2 =
-    let ReportsKeyMap _ _ _ _ _ _ = undefined
+    let ReportsKeyMap _ _ _ _ _ _ _ = undefined
      in ReportsKeyMap
           { reportsKeymapNextActionReportKeyMap =
               reportsKeymapNextActionReportKeyMap rkm1 <> reportsKeymapNextActionReportKeyMap rkm2,
             reportsKeymapWaitingReportKeyMap =
               reportsKeymapWaitingReportKeyMap rkm1 <> reportsKeymapWaitingReportKeyMap rkm2,
+            reportsKeymapOngoingReportKeyMap =
+              reportsKeymapOngoingReportKeyMap rkm1 <> reportsKeymapOngoingReportKeyMap rkm2,
             reportsKeymapTimestampsReportKeyMap =
               reportsKeymapTimestampsReportKeyMap rkm1 <> reportsKeymapTimestampsReportKeyMap rkm2,
             reportsKeymapStuckReportKeyMap =
@@ -250,6 +255,7 @@ instance Monoid ReportsKeyMap where
     ReportsKeyMap
       { reportsKeymapNextActionReportKeyMap = mempty,
         reportsKeymapWaitingReportKeyMap = mempty,
+        reportsKeymapOngoingReportKeyMap = mempty,
         reportsKeymapTimestampsReportKeyMap = mempty,
         reportsKeymapStuckReportKeyMap = mempty,
         reportsKeymapWorkReportKeyMap = mempty,
@@ -258,10 +264,11 @@ instance Monoid ReportsKeyMap where
 
 reportsKeyMapActions :: ReportsKeyMap -> [AnyAction]
 reportsKeyMapActions ReportsKeyMap {..} =
-  let ReportsKeyMap _ _ _ _ _ _ = undefined
+  let ReportsKeyMap _ _ _ _ _ _ _ = undefined
    in concat
         [ nextActionReportKeyMapActions reportsKeymapNextActionReportKeyMap,
           waitingReportKeyMapActions reportsKeymapWaitingReportKeyMap,
+          ongoingReportKeyMapActions reportsKeymapOngoingReportKeyMap,
           timestampsReportKeyMapActions reportsKeymapTimestampsReportKeyMap,
           stuckReportKeyMapActions reportsKeymapStuckReportKeyMap,
           workReportKeyMapActions reportsKeymapWorkReportKeyMap,
@@ -338,6 +345,41 @@ waitingReportKeyMapActions WaitingReportKeyMap {..} =
           waitingReportAnyMatchers
         ]
 
+data OngoingReportKeyMap = OngoingReportKeyMap
+  { ongoingReportMatchers :: KeyMappings,
+    ongoingReportSearchMatchers :: KeyMappings,
+    ongoingReportAnyMatchers :: KeyMappings
+  }
+  deriving (Generic)
+
+instance Semigroup OngoingReportKeyMap where
+  narkm1 <> narkm2 =
+    let OngoingReportKeyMap _ _ _ = undefined
+     in OngoingReportKeyMap
+          { ongoingReportMatchers = ongoingReportMatchers narkm1 <> ongoingReportMatchers narkm2,
+            ongoingReportSearchMatchers = ongoingReportSearchMatchers narkm1 <> ongoingReportSearchMatchers narkm2,
+            ongoingReportAnyMatchers = ongoingReportAnyMatchers narkm1 <> ongoingReportAnyMatchers narkm2
+          }
+
+instance Monoid OngoingReportKeyMap where
+  mappend = (<>)
+  mempty =
+    OngoingReportKeyMap
+      { ongoingReportMatchers = mempty,
+        ongoingReportSearchMatchers = mempty,
+        ongoingReportAnyMatchers = mempty
+      }
+
+ongoingReportKeyMapActions :: OngoingReportKeyMap -> [AnyAction]
+ongoingReportKeyMapActions OngoingReportKeyMap {..} =
+  let OngoingReportKeyMap _ _ _ = undefined
+   in concatMap
+        keyMappingsActions
+        [ ongoingReportMatchers,
+          ongoingReportSearchMatchers,
+          ongoingReportAnyMatchers
+        ]
+
 data TimestampsReportKeyMap = TimestampsReportKeyMap
   { timestampsReportMatchers :: KeyMappings,
     timestampsReportSearchMatchers :: KeyMappings,
@@ -551,7 +593,8 @@ runSmosM ::
 runSmosM = runMkSmosM
 
 data SmosState = SmosState
-  { smosStateTime :: !ZonedTime,
+  { smosStateNow :: !UTCTime,
+    smosStateTimeZone :: !TZ,
     smosStateCursor :: !EditorCursor,
     smosStateKeyHistory :: !(Seq KeyPress),
     smosStateAsyncs :: ![Async ()],
@@ -943,6 +986,13 @@ editorCursorSwitchToHelp km@KeyMap {..} ec =
                                   case entryReportCursorSelection waitingReportCursorEntryReportCursor of
                                     EntryReportSelected -> ("Waiting Report", waitingReportMatchers)
                                     EntryReportFilterSelected -> ("Waiting Report, Search", waitingReportSearchMatchers)
+                          ReportOngoing OngoingReportCursor {..} ->
+                            let OngoingReportKeyMap {..} = reportsKeymapOngoingReportKeyMap
+                                OngoingReportKeyMap _ _ _ = reportsKeymapOngoingReportKeyMap
+                             in (\(t, ms) -> (t, ms ++ ongoingReportAnyMatchers)) $
+                                  case entryReportCursorSelection ongoingReportCursorEntryReportCursor of
+                                    EntryReportSelected -> ("Ongoing Report", ongoingReportMatchers)
+                                    EntryReportFilterSelected -> ("Ongoing Report, Search", ongoingReportSearchMatchers)
                           ReportTimestamps TimestampsReportCursor {..} ->
                             let TimestampsReportKeyMap {..} = reportsKeymapTimestampsReportKeyMap
                                 TimestampsReportKeyMap _ _ _ = reportsKeymapTimestampsReportKeyMap
@@ -965,11 +1015,8 @@ editorCursorSwitchToHelp km@KeyMap {..} ec =
           editorCursorSelection = HelpSelected
         }
 
-editorCursorUpdateTime :: ZonedTime -> EditorCursor -> EditorCursor
+editorCursorUpdateTime :: TZ -> UTCTime -> EditorCursor -> EditorCursor
-editorCursorUpdateTime zt ec =
+editorCursorUpdateTime zone now ec = ec {editorCursorFileCursor = smosFileEditorCursorUpdateTime zone now <$> editorCursorFileCursor ec}
-  ec
-    { editorCursorFileCursor = smosFileEditorCursorUpdateTime zt <$> editorCursorFileCursor ec
-    }
 
 data EditorSelection
   = FileSelected
@@ -983,6 +1030,7 @@ instance Validity EditorSelection
 data ReportCursor
   = ReportNextActions !NextActionReportCursor
   | ReportWaiting !WaitingReportCursor
+  | ReportOngoing !OngoingReportCursor
   | ReportTimestamps !TimestampsReportCursor
   | ReportStuck !StuckReportCursor
   | ReportWork !WorkReportCursor

smos/test/Smos/OptParse/Gen.hs

@@ -37,6 +37,10 @@ instance GenValid WaitingReportKeyConfigs where
   genValid = genValidStructurally
   shrinkValid = shrinkValidStructurally
 
+instance GenValid OngoingReportKeyConfigs where
+  genValid = genValidStructurally
+  shrinkValid = shrinkValidStructurally
+
 instance GenValid TimestampsReportKeyConfigs where
   genValid = genValidStructurally
   shrinkValid = shrinkValidStructurally