Simple interactive terminal user interface (without brick)

README.md

@@ -1,17 +1,95 @@
 # t4: terminal time tracking tool
 
-Haskell library and terminal GUI tool for time tracking.
+**Haskell library and command line tools for simple time tracking.**
 
-## Run command tool
+Storage uses very human-friendly yaml files in `~/.t4-data` that can be edited manually:
 
-    cabal run t4
+```
+memowe@rakete:~$ ls ~/.t4-data
+2025-10-15.yml  2025-10-25.yml  2025-10-24.yml
+2025-10-23.yml  2025-10-27.yml
+```
 
-## Run tests
+```yaml
+$ cat ~/.t4-data/2025-10-27.yml 
+- in:
+    category: Writing t4 README
+    tags:
+    - t4
+    - haskell
+    - documentation
+    time: 2025-10-27 10:24:57
+- out:
+    time: 2025-10-27 10:29:12
+- in:
+    category: Lunch break
+    tags:
+    - break
+    - recreation
+    - nom
+    time: 2025-10-27 12:42:17
+```
 
+The project offers two command-line interfaces to edit these files for you.
+
+## Preparations
+
+This is a standard [GHC][ghc]/[cabal][cabal] project with a core [library](lib) and two executables [t4](exe-t4-commands)/[t5](exe-t5-interactive), so you can use the standard cabal commands to build dependencies, the project itself and run tests:
+
+    cabal build --only-dependencies --enable-tests
+    cabal build
     cabal test --test-show-details=direct
 
+You can also build the core library's [Haddock API docs][haddock] by yourself (although they are not extensively commented):
+
+    cabal haddock
+
+## Command-based terminal interface `t4`
+
+You can run the command-based tool (*terminal time tracking tool*) without installing using `cabal run t4 -- ARGUMENTS` and install it via `cabal install`.
+
+```
+$ t4 --help
+t4 - terminal time tracking tool
+
+Usage: t4 COMMAND
+
+  Simple interface for clocking in and out
+
+Available options:
+  -h,--help                Show this help text
+
+Available commands:
+  in                       Clocking in
+  out                      Clocking out
+  status                   Show current status
+  categories               List all categories
+  tags                     List all tags
+  report                   Report
+
+$ t4 status
+IN (2025-10-27 10:24:57) [Writing t4 README] #t4 #haskell #documentation
+```
+
+## Interactive terminal interface `t5`
+
+You can run the interactive terminal interface (*terminal time tracking tool terminal user interface*) without installing using `cabal run t5` and install it via `cabal install`.
+
+```
+$ t5
+IN (2025-10-27 10:24:57) [Writing t4 README] #t4 #haskell #documentation
+Spent: 4mi 5s
+[o]ut - [u]pdate - report [c]ategories - report [t]ags - [q]uit: o
+Spent: 4mi 15s
+OUT (2025-10-27 10:29:12)
+```
+
 ## Author and license
 
 (c) 2025 Mirko Westermeier
 
 Released under the MIT license. See [LICENSE](LICENSE) for details.
+
+[ghc]: https://www.haskell.org/ghc/
+[cabal]: https://www.haskell.org/cabal/
+[haddock]: http://mirko.westermeier.de/t4/

t4-commands/Commands.hs → exe-t4-commands/Commands.hs

@@ -2,13 +2,12 @@ module Main where
 
 import T4.Data
 import T4.Storage
+import T4.Report
 import qualified Util as U
 import Data.List
+import Data.Map
 import Data.Time
-import Data.Map (Map, toList)
-import Control.Monad
 import Options.Applicative
-import T4.Report (categoryDurations, tagDurations)
 
 data Command  = CmdIn { ccat  :: Maybe Category
                       , ctags :: [Tag]
@@ -17,8 +16,7 @@ data Command  = CmdIn { ccat  :: Maybe Category
               | CmdStatus
               | CmdCats
               | CmdTags
-              | CmdReport { crepCat   :: Bool
-                          , crepTags  :: Bool
+              | CmdReport { crepTags  :: Bool
                           , ordByLen  :: Bool
                           , natDur    :: Bool
                           , showSecs  :: Bool
@@ -53,28 +51,22 @@ commandParser = hsubparser
                                   )
                       )
         reportParser  =
-          correct <$> switch  (   long "categories"
-                              <>  short 'c'
-                              <>  help "Include categories in the report"
-                              )
-                  <*> switch  (   long "tags"
-                              <>  short 't'
-                              <>  help "Include tags in the report"
-                              )
-                  <*> switch  (   long "order-by-length"
-                              <>  short 'l'
-                              <>  help "Reports should be ordered by length"
-                              )
-                  <*> switch  (   long "natural-time"
-                              <>  short 'n'
-                              <>  help "Natural durations instead of man-days"
-                              )
-                  <*> switch  (   long "show-seconds"
-                              <>  short 's'
-                              <>  help "Show seconds"
-                              )
-          where correct False False = CmdReport True  True
-                correct c     t     = CmdReport c     t
+          CmdReport <$> switch  (   long "tags"
+                                <>  short 't'
+                                <>  help "Show tags instead of categories"
+                                )
+                    <*> switch  (   long "order-by-length"
+                                <>  short 'l'
+                                <>  help "Reports should be ordered by length"
+                                )
+                    <*> switch  (   long "natural-time"
+                                <>  short 'n'
+                                <>  help "Natural durations instead of man-days"
+                                )
+                    <*> switch  (   long "show-seconds"
+                                <>  short 's'
+                                <>  help "Show seconds"
+                                )
 
 opts :: ParserInfo Command
 opts = info (commandParser <**> helper)
@@ -101,30 +93,17 @@ handle CmdCats      = do  clocks <- getClocks
                           mapM_ putStrLn (sort $ allCategories clocks)
 handle CmdTags      = do  clocks <- getClocks
                           mapM_ putStrLn (sort $ allTags clocks)
-handle (CmdReport True True obl man secs) = do
+handle (CmdReport t obl man secs) = do
   clocks <- getClocks
-  putStrLn "Categories"
-  showDurMap 2 obl man secs $ categoryDurations clocks
-  putStrLn "Tags"
-  showDurMap 2 obl man secs $ tagDurations clocks
-handle (CmdReport c t obl man secs) = do
-  clocks <- getClocks
-  when c $ showDurMap 0 obl man secs $ categoryDurations clocks
-  when t $ showDurMap 0 obl man secs $ tagDurations clocks
+  let durMap = (if t then tagDurations else categoryDurations) clocks
+  printDurMap obl man secs durMap
+
+printDurMap :: Bool -> Bool -> Bool -> Map String NominalDiffTime -> IO ()
+printDurMap o n s = mapM_ putStrLn . showDurMap o n s
 
 getClocks :: IO [Clock]
 getClocks = loadDataFromDir =<< getStorageDirectory
 
-showDurMap :: Int -> Bool -> Bool -> Bool -> Map String NominalDiffTime -> IO ()
-showDurMap indent bySnd natural secs m = do
-  forM_ (ordPairs $ toList m) $ \(x, ndt) -> do
-    putStr    $ replicate indent ' '
-    putStrLn  $ x ++ ": " ++ showDT durConf ndt
-  where ordPairs  = if bySnd    then sortOn snd else sortOn fst
-        showDT    = if secs     then U.showDiffTime else U.showRoughDiffTime
-        durConf   = if natural  then U.naturalDurationConfig
-                                else U.manDurationConfig
-
 main :: IO ()
 main = do
   cmd <- execParser opts

exe-t5-interactive/TUI.hs

@@ -0,0 +1,92 @@
+import T4.Data
+import T4.Storage
+import T4.Report
+import Util
+import Completion
+import Data.Char
+import Data.List
+import Data.Maybe
+import Data.Function
+import Data.Map (Map)
+import Data.Time
+import qualified System.Console.Haskeline as H
+
+main :: IO ()
+main = do
+  sdir  <- getStorageDirectory
+  clock <- lastMaybe <$> loadDataFromDir sdir
+  showState clock
+  newClock <- if isJust clock && isIn (fromJust clock)
+                then promptIn (time $ fromJust clock)
+                else promptOut
+  case newClock of
+    Nothing -> showState clock
+    Just c  -> do addClockToDir sdir c
+                  showState (Just c)
+
+showState :: Maybe Clock -> IO ()
+showState = putStrLn . maybe "No clock data yet" summary
+
+promptIn :: SimpleLocalTime -> IO (Maybe Clock)
+promptIn started = do
+  showSpent started
+  clocks <- loadDataFromDir =<< getStorageDirectory
+  choice <- run $ H.getInputChar
+    "[o]ut - [u]pdate - report [c]ategories - report [t]ags - [q]uit: "
+  case choice of
+    Just 'o'  -> showSpent started >> Just . Out <$> getCurrentSLT
+    Just 'u'  -> Just <$> clockIn
+    Just 'c'  -> Nothing <$ report "Categories" (categoryDurations clocks)
+    Just 't'  -> Nothing <$ report "Tags"       (tagDurations clocks)
+    _         -> return Nothing
+
+showSpent :: SimpleLocalTime -> IO ()
+showSpent started = do
+  now <- getCurrentSLT
+  putStrLn $ "Spent: " ++ showDuration (now `minusTime` started)
+  where showDuration  = showDiffTime naturalDurationConfig
+        minusTime     = diffLocalTime `on` getLocalTime
+
+promptOut :: IO (Maybe Clock)
+promptOut = do
+  clocks <- loadDataFromDir =<< getStorageDirectory
+  choice <- run $ H.getInputChar
+    "[i]n - report [c]ategories - report [t]ags - [q]uit: "
+  case choice of
+    Just 'i'  -> Just <$> clockIn
+    Just 'c'  -> Nothing <$ report "Categories" (categoryDurations clocks)
+    Just 't'  -> Nothing <$ report "Tags"       (tagDurations clocks)
+    _         -> return Nothing
+
+clockIn :: IO Clock
+clockIn = do
+  clocks <- loadDataFromDir =<< getStorageDirectory
+  let catsCompl = (`Compl` id) $ allCategories clocks
+      tagsCompl = (`Compl` id) $ allTags clocks
+  now   <- getCurrentSLT
+  mc    <- runWithCompletion catsCompl $ H.getInputLine "Category: "
+  mtags <- runWithCompletion tagsCompl $ H.getInputLine "Tags: "
+  return $ In now (parseCat mc) (parseTags mtags)
+  where parseCat  = fmap $ dropWhile isSpace . dropWhileEnd isSpace
+        parseTags = map (dropWhile (== '#')) . words . fromMaybe ""
+
+report :: String -> Map String NominalDiffTime -> IO ()
+report prefix durMap = do
+  putStrLn "[s]econds - [l]ength-ordered - [n]atural time instead of man-days"
+  mOptions <- run $ H.getInputLine "Options: "
+  case mOptions of
+    Nothing       -> return ()
+    Just options  -> do
+      putStrLn prefix
+      let optSecs = 's' `elem` options
+          optLen  = 'l' `elem` options
+          optNat  = 'n' `elem` options
+      mapM_ putStrLn $ showDurMap optLen optNat optSecs durMap
+
+run :: H.InputT IO a -> IO a
+run = H.runInputTBehavior H.preferTerm H.defaultSettings
+
+runWithCompletion :: Completion c -> H.InputT IO a -> IO a
+runWithCompletion compl = H.runInputTBehavior H.preferTerm settings
+  where settings  = (H.defaultSettings :: H.Settings IO) {H.complete = hcompl}
+        hcompl    = haskelineCompletionFunc compl

lib/Completion.hs

@@ -3,15 +3,23 @@ module Completion where
 import Data.Char
 import Data.List
 import Data.Function
+import qualified System.Console.Haskeline.Completion as HC
 
 data Completion a = Compl
   { complItems    :: [a]
   , complToString :: a -> String
   }
 
 complMatch :: String -> String -> Bool
-complMatch "" = const False
-complMatch cs = (isSubsequenceOf `on` map toLower) cs
+complMatch = isSubsequenceOf `on` map toLower
 
 complete :: Completion a -> String -> [a]
 complete (Compl xs toStr) cs = filter (complMatch cs . toStr) xs
+
+haskelineCompletions :: Completion a -> String -> [HC.Completion]
+haskelineCompletions c@(Compl _ toString) =
+  map (HC.simpleCompletion . toString) . complete c
+
+haskelineCompletionFunc :: Monad m => Completion a -> HC.CompletionFunc m
+haskelineCompletionFunc =
+  HC.completeWord Nothing " " . (return .) . haskelineCompletions

lib/T4/Report.hs

@@ -2,7 +2,8 @@ module T4.Report where
 
 import T4.Data
 import Util
-import Data.Map (Map)
+import Data.List
+import Data.Map
 import Data.Time
 
 categoryDurations :: [Clock] -> Map Category NominalDiffTime
@@ -14,3 +15,11 @@ tagDurations :: [Clock] -> Map Tag NominalDiffTime
 tagDurations = durations select
   where select (In t _ ts)  = (ts,  getLocalTime t)
         select c            = ([],  getLocalTime $ time c)
+
+showDurMap :: Bool -> Bool -> Bool -> Map String NominalDiffTime -> [String]
+showDurMap bySnd natural secs m =
+  fmap (\(x, ndt) -> x ++ ": " ++ showDT durConf ndt) (ordPairs $ toList m)
+  where ordPairs  = if bySnd    then sortOn snd else sortOn fst
+        showDT    = if secs     then showDiffTime else showRoughDiffTime
+        durConf   = if natural  then naturalDurationConfig
+                                else manDurationConfig

lib/Util.hs

@@ -69,3 +69,7 @@ showRoughDiffTime dc = showDiffTimeSplits . init . splitDiffTime dc
 
 getCurrentSLT :: IO SimpleLocalTime
 getCurrentSLT = SLT . zonedTimeToLocalTime <$> getZonedTime
+
+lastMaybe :: [a] -> Maybe a
+lastMaybe [] = Nothing
+lastMaybe xs = Just (last xs)

terminal-time-tracking-tool.cabal

@@ -32,7 +32,7 @@ common basics
                     , yaml
                     , regex-tdfa
                     , text
-                    , brick
+                    , haskeline
 
 library
   import:             basics
@@ -48,10 +48,16 @@ executable t4
   build-depends:      terminal-time-tracking-tool
                     , optparse-applicative
                     , mtl
-  hs-source-dirs:     t4-commands
+  hs-source-dirs:     exe-t4-commands
   main-is:            Commands.hs
 
-test-suite t4-test
+executable t5
+  import:             basics
+  build-depends:      terminal-time-tracking-tool
+  hs-source-dirs:     exe-t5-interactive
+  main-is:            TUI.hs
+
+test-suite library-test
   import:             basics
   ghc-options:        -Wno-orphans
   type:               exitcode-stdio-1.0