summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Omni/Task.hs14
-rw-r--r--Omni/Task/Core.hs173
-rw-r--r--Omni/Task/RaceTest.hs31
3 files changed, 114 insertions, 104 deletions
diff --git a/Omni/Task.hs b/Omni/Task.hs
index 956333f..65e5c42 100644
--- a/Omni/Task.hs
+++ b/Omni/Task.hs
@@ -15,11 +15,11 @@ import qualified Omni.Namespace as Namespace
import Omni.Task.Core
import qualified Omni.Task.RaceTest as RaceTest
import qualified Omni.Test as Test
-import qualified Test.Tasty as Tasty
import qualified System.Console.Docopt as Docopt
import System.Directory (doesFileExist, removeFile)
import System.Environment (setEnv)
import System.Process (callCommand)
+import qualified Test.Tasty as Tasty
main :: IO ()
main = Cli.main plan
@@ -278,11 +278,13 @@ move args
Just val -> pure (T.pack val)
test :: Test.Tree
-test = Test.group "Omni.Task"
- [ unitTests,
- cliTests,
- Tasty.after Tasty.AllSucceed "Unit tests" RaceTest.test
- ]
+test =
+ Test.group
+ "Omni.Task"
+ [ unitTests,
+ cliTests,
+ Tasty.after Tasty.AllSucceed "Unit tests" RaceTest.test
+ ]
unitTests :: Test.Tree
unitTests =
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs
index 066ad95..1441a54 100644
--- a/Omni/Task/Core.hs
+++ b/Omni/Task/Core.hs
@@ -144,9 +144,10 @@ withTaskWriteLock action =
tasksFile <- getTasksFilePath
let lockFile = tasksFile <> ".lock"
bracket
- (do
- h <- IO.openFile lockFile IO.ReadWriteMode
- handleToFd h)
+ ( do
+ h <- IO.openFile lockFile IO.ReadWriteMode
+ handleToFd h
+ )
closeFd
( \fd -> do
waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
@@ -164,9 +165,10 @@ withTaskReadLock action =
tasksFile <- getTasksFilePath
let lockFile = tasksFile <> ".lock"
bracket
- (do
- h <- IO.openFile lockFile IO.ReadWriteMode
- handleToFd h)
+ ( do
+ h <- IO.openFile lockFile IO.ReadWriteMode
+ handleToFd h
+ )
closeFd
( \fd -> do
waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0)
@@ -191,9 +193,10 @@ generateId = do
-- Generate a child ID based on parent ID (e.g. "t-abc.1", "t-abc.1.2")
-- Finds the next available sequential suffix among existing children.
generateChildId :: Text -> IO Text
-generateChildId parentId = withTaskReadLock <| do
- tasks <- loadTasksInternal
- pure <| computeNextChildId tasks parentId
+generateChildId parentId =
+ withTaskReadLock <| do
+ tasks <- loadTasksInternal
+ pure <| computeNextChildId tasks parentId
computeNextChildId :: [Task] -> Text -> Text
computeNextChildId tasks parentId =
@@ -302,43 +305,45 @@ saveTaskInternal task = do
-- Create a new task
createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> IO Task
-createTask title taskType parent namespace priority deps = withTaskWriteLock <| do
- tid <- case parent of
- Nothing -> generateId
- Just pid -> do
- tasks <- loadTasksInternal
- pure <| computeNextChildId tasks pid
- now <- getCurrentTime
- let task =
- Task
- { taskId = tid,
- taskTitle = title,
- taskType = taskType,
- taskParent = parent,
- taskNamespace = namespace,
- taskStatus = Open,
- taskPriority = priority,
- taskDependencies = deps,
- taskCreatedAt = now,
- taskUpdatedAt = now
- }
- saveTaskInternal task
- pure task
+createTask title taskType parent namespace priority deps =
+ withTaskWriteLock <| do
+ tid <- case parent of
+ Nothing -> generateId
+ Just pid -> do
+ tasks <- loadTasksInternal
+ pure <| computeNextChildId tasks pid
+ now <- getCurrentTime
+ let task =
+ Task
+ { taskId = tid,
+ taskTitle = title,
+ taskType = taskType,
+ taskParent = parent,
+ taskNamespace = namespace,
+ taskStatus = Open,
+ taskPriority = priority,
+ taskDependencies = deps,
+ taskCreatedAt = now,
+ taskUpdatedAt = now
+ }
+ saveTaskInternal task
+ pure task
-- Update task status
updateTaskStatus :: Text -> Status -> IO ()
-updateTaskStatus tid newStatus = withTaskWriteLock <| do
- tasks <- loadTasksInternal
- now <- getCurrentTime
- let updatedTasks = map updateIfMatch tasks
- updateIfMatch t =
- if matchesId (taskId t) tid
- then t {taskStatus = newStatus, taskUpdatedAt = now}
- else t
- -- Rewrite the entire file (simple approach for MVP)
- tasksFile <- getTasksFilePath
- TIO.writeFile tasksFile ""
- traverse_ saveTaskInternal updatedTasks
+updateTaskStatus tid newStatus =
+ withTaskWriteLock <| do
+ tasks <- loadTasksInternal
+ now <- getCurrentTime
+ let updatedTasks = map updateIfMatch tasks
+ updateIfMatch t =
+ if matchesId (taskId t) tid
+ then t {taskStatus = newStatus, taskUpdatedAt = now}
+ else t
+ -- Rewrite the entire file (simple approach for MVP)
+ tasksFile <- getTasksFilePath
+ TIO.writeFile tasksFile ""
+ traverse_ saveTaskInternal updatedTasks
-- List tasks, optionally filtered by type, parent, status, or namespace
listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task]
@@ -501,7 +506,7 @@ showTaskTree maybeId = do
InProgress -> "[~]"
Review -> "[?]"
Done -> "[✓]"
-
+
coloredStatusStr = case taskType task of
Epic -> magenta statusStr
WorkTask -> case taskStatus task of
@@ -513,7 +518,7 @@ showTaskTree maybeId = do
nsStr = case taskNamespace task of
Nothing -> ""
Just ns -> "[" <> ns <> "] "
-
+
coloredNsStr = case taskNamespace task of
Nothing -> ""
Just _ -> gray nsStr
@@ -525,7 +530,7 @@ showTaskTree maybeId = do
if T.length (taskTitle task) > availableWidth
then T.take (availableWidth - 3) (taskTitle task) <> "..."
else taskTitle task
-
+
coloredTitle = if taskType task == Epic then bold truncatedTitle else truncatedTitle
putText <| prefix <> cyan (taskId task) <> " " <> coloredStatusStr <> " " <> coloredNsStr <> coloredTitle
@@ -552,16 +557,16 @@ printTask t = do
completed = length <| filter (\child -> taskStatus child == Done) children
in " [" <> T.pack (show completed) <> "/" <> T.pack (show total) <> "]"
else ""
-
+
parentInfo = case taskParent t of
Nothing -> ""
Just p -> " (parent: " <> p <> ")"
-
+
namespaceInfo = case taskNamespace t of
Nothing -> ""
Just ns -> " [" <> ns <> "]"
- coloredStatus =
+ coloredStatus =
let s = "[" <> T.pack (show (taskStatus t)) <> "]"
in case taskStatus t of
Open -> bold s
@@ -570,13 +575,13 @@ printTask t = do
Done -> green s
coloredTitle = if taskType t == Epic then bold (taskTitle t) else taskTitle t
-
+
coloredProgress = if taskType t == Epic then magenta progressInfo else progressInfo
-
+
coloredNamespace = case taskNamespace t of
Nothing -> ""
Just _ -> gray namespaceInfo
-
+
coloredParent = case taskParent t of
Nothing -> ""
Just _ -> gray parentInfo
@@ -653,12 +658,13 @@ bold t = "\ESC[1m" <> t <> "\ESC[0m"
-- Export tasks: Consolidate JSONL file (remove duplicates, keep latest version)
exportTasks :: IO ()
-exportTasks = withTaskWriteLock <| do
- tasks <- loadTasksInternal
- -- Rewrite the entire file with deduplicated tasks
- tasksFile <- getTasksFilePath
- TIO.writeFile tasksFile ""
- traverse_ saveTaskInternal tasks
+exportTasks =
+ withTaskWriteLock <| do
+ tasks <- loadTasksInternal
+ -- Rewrite the entire file with deduplicated tasks
+ tasksFile <- getTasksFilePath
+ TIO.writeFile tasksFile ""
+ traverse_ saveTaskInternal tasks
-- Task statistics
data TaskStats = TaskStats
@@ -778,31 +784,32 @@ showTaskStats maybeEpicId = do
-- Import tasks: Read from another JSONL file and merge with existing tasks
importTasks :: FilePath -> IO ()
-importTasks filePath = withTaskWriteLock <| do
- exists <- doesFileExist filePath
- unless exists <| panic (T.pack filePath <> " does not exist")
-
- -- Load tasks from import file
- content <- TIO.readFile filePath
- let importLines = T.lines content
- importedTasks = mapMaybe decodeTask importLines
-
- -- Load existing tasks
- existingTasks <- loadTasksInternal
-
- -- Create a map of existing task IDs for quick lookup
- let existingIds = map taskId existingTasks
- -- Filter to only new tasks (not already in our database)
- newTasks = filter (\t -> not (any (`matchesId` taskId t) existingIds)) importedTasks
- -- For tasks that exist, update them with imported data
- updatedTasks = map (updateWithImported importedTasks) existingTasks
- -- Combine: updated existing tasks + new tasks
- allTasks = updatedTasks ++ newTasks
-
- -- Rewrite tasks.jsonl with merged data
- tasksFile <- getTasksFilePath
- TIO.writeFile tasksFile ""
- traverse_ saveTaskInternal allTasks
+importTasks filePath =
+ withTaskWriteLock <| do
+ exists <- doesFileExist filePath
+ unless exists <| panic (T.pack filePath <> " does not exist")
+
+ -- Load tasks from import file
+ content <- TIO.readFile filePath
+ let importLines = T.lines content
+ importedTasks = mapMaybe decodeTask importLines
+
+ -- Load existing tasks
+ existingTasks <- loadTasksInternal
+
+ -- Create a map of existing task IDs for quick lookup
+ let existingIds = map taskId existingTasks
+ -- Filter to only new tasks (not already in our database)
+ newTasks = filter (\t -> not (any (`matchesId` taskId t) existingIds)) importedTasks
+ -- For tasks that exist, update them with imported data
+ updatedTasks = map (updateWithImported importedTasks) existingTasks
+ -- Combine: updated existing tasks + new tasks
+ allTasks = updatedTasks ++ newTasks
+
+ -- Rewrite tasks.jsonl with merged data
+ tasksFile <- getTasksFilePath
+ TIO.writeFile tasksFile ""
+ traverse_ saveTaskInternal allTasks
where
decodeTask :: Text -> Maybe Task
decodeTask line =
diff --git a/Omni/Task/RaceTest.hs b/Omni/Task/RaceTest.hs
index d4780fd..10d3451 100644
--- a/Omni/Task/RaceTest.hs
+++ b/Omni/Task/RaceTest.hs
@@ -4,13 +4,13 @@
module Omni.Task.RaceTest where
import Alpha
+import Control.Concurrent.Async (mapConcurrently)
+import Data.List (nub)
+import qualified Data.Text as T
import Omni.Task.Core
import qualified Omni.Test as Test
import System.Directory (doesFileExist, removeFile)
import System.Environment (setEnv)
-import Control.Concurrent.Async (mapConcurrently)
-import qualified Data.Text as T
-import Data.List (nub)
test :: Test.Tree
test = Test.group "Omni.Task.Race" [raceTest]
@@ -21,35 +21,36 @@ raceTest =
-- Set up test mode
setEnv "TASK_TEST_MODE" "1"
setEnv "TASK_DB_PATH" ".tasks/race-test.jsonl"
-
+
-- Clean up test database
let testFile = ".tasks/race-test.jsonl"
exists <- doesFileExist testFile
when exists <| removeFile testFile
initTaskDb
-
+
-- Create a parent epic
parent <- createTask "Parent Epic" Epic Nothing Nothing P2 []
let parentId = taskId parent
-
+
-- Create multiple children concurrently
-- We'll create 10 children in parallel
let childCount = 10
- indices = [1..childCount]
-
+ indices = [1 .. childCount]
+
-- Run concurrent creations
- children <- mapConcurrently
- (\i -> createTask ("Child " <> tshow i) WorkTask (Just parentId) Nothing P2 [])
- indices
-
+ children <-
+ mapConcurrently
+ (\i -> createTask ("Child " <> tshow i) WorkTask (Just parentId) Nothing P2 [])
+ indices
+
-- Check for duplicates in generated IDs
let ids = map taskId children
uniqueIds = nub ids
-
+
-- If there was a race condition, we'd have fewer unique IDs than children
length uniqueIds Test.@?= length children
length uniqueIds Test.@?= childCount
-
+
-- Verify IDs follow the pattern parentId.N
for_ ids <| \tid -> do
- (parentId `T.isPrefixOf` tid) Test.@?= True
+ (parentId `T.isPrefixOf` tid) Test.@?= True
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-16 20:44:28 +0000