diff options
Diffstat (limited to 'Omni/Task')
| -rw-r--r-- | Omni/Task/Core.hs | 558 |
1 files changed, 230 insertions, 328 deletions
diff --git a/Omni/Task/Core.hs b/Omni/Task/Core.hs index 1eb820f..4ce9066 100644 --- a/Omni/Task/Core.hs +++ b/Omni/Task/Core.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} module Omni.Task.Core where @@ -7,21 +8,19 @@ module Omni.Task.Core where import Alpha import Data.Aeson (FromJSON, ToJSON, decode, encode) import qualified Data.Aeson as Aeson -import qualified Data.Aeson.KeyMap as KM -import Data.Aeson.Types (parseMaybe) import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.List as List import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDay, utctDayTime) import Data.Time.Calendar (toModifiedJulianDay) +import qualified Database.SQLite.Simple as SQL +import qualified Database.SQLite.Simple.FromField as SQL +import qualified Database.SQLite.Simple.Ok as SQLOk +import qualified Database.SQLite.Simple.ToField as SQL import GHC.Generics () import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) -import System.IO (SeekMode (AbsoluteSeek)) -import qualified System.IO as IO -import System.IO.Unsafe (unsafePerformIO) -import System.Posix.IO (LockRequest (..), closeFd, handleToFd, waitToSetLock) -- Core data types data Task = Task @@ -40,14 +39,14 @@ data Task = Task deriving (Show, Eq, Generic) data TaskType = Epic | WorkTask | HumanTask - deriving (Show, Eq, Generic) + deriving (Show, Eq, Read, Generic) data Status = Open | InProgress | Review | Approved | Done - deriving (Show, Eq, Generic) + deriving (Show, Eq, Read, Generic) -- Priority levels (matching beads convention) data Priority = P0 | P1 | P2 | P3 | P4 - deriving (Show, Eq, Ord, Generic) + deriving (Show, Eq, Ord, Read, Generic) data Dependency = Dependency { depId :: Text, -- ID of the task this depends on @@ -60,7 +59,7 @@ data DependencyType | DiscoveredFrom -- Work discovered during other work | ParentChild -- Epic/subtask relationship | Related -- Soft relationship, doesn't block - deriving (Show, Eq, Generic) + deriving (Show, Eq, Read, Generic) data TaskProgress = TaskProgress { progressTaskId :: Text, @@ -94,6 +93,83 @@ instance ToJSON Task instance FromJSON Task +instance ToJSON TaskProgress + +instance FromJSON TaskProgress + +-- SQLite Instances + +instance SQL.FromField TaskType where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid TaskType" + +instance SQL.ToField TaskType where + toField x = SQL.toField (show x :: String) + +instance SQL.FromField Status where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid Status" + +instance SQL.ToField Status where + toField x = SQL.toField (show x :: String) + +instance SQL.FromField Priority where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case readMaybe t of + Just x -> pure x + Nothing -> SQL.returnError SQL.ConversionFailed f "Invalid Priority" + +instance SQL.ToField Priority where + toField x = SQL.toField (show x :: String) + +-- Store dependencies as JSON text +instance SQL.FromField [Dependency] where + fromField f = do + t <- SQL.fromField f :: SQLOk.Ok String + case Aeson.decode (BLC.pack t) of + Just x -> pure x + Nothing -> pure [] -- Default to empty if parse fail or null + +instance SQL.ToField [Dependency] where + toField deps = SQL.toField (BLC.unpack (encode deps)) + +instance SQL.FromRow Task where + fromRow = + Task + </ SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + <*> SQL.field + +instance SQL.ToRow Task where + toRow t = + [ SQL.toField (taskId t), + SQL.toField (taskTitle t), + SQL.toField (taskType t), + SQL.toField (taskParent t), + SQL.toField (taskNamespace t), + SQL.toField (taskStatus t), + SQL.toField (taskPriority t), + SQL.toField (taskDependencies t), + SQL.toField (taskDescription t), + SQL.toField (taskCreatedAt t), + SQL.toField (taskUpdatedAt t) + ] + -- | Case-insensitive ID comparison matchesId :: Text -> Text -> Bool matchesId id1 id2 = normalizeId id1 == normalizeId id2 @@ -118,108 +194,66 @@ normalizeTask t = normalizeDependency :: Dependency -> Dependency normalizeDependency d = d {depId = normalizeId (depId d)} -instance ToJSON TaskProgress - -instance FromJSON TaskProgress - --- Get the tasks database file path (use test file if TASK_TEST_MODE is set) -getTasksFilePath :: IO FilePath -getTasksFilePath = do +-- Get the tasks database file path +getTasksDbPath :: IO FilePath +getTasksDbPath = do customPath <- lookupEnv "TASK_DB_PATH" testMode <- lookupEnv "TASK_TEST_MODE" let path = case (customPath, testMode) of (Just p, _) -> p - (_, Just "1") -> ".tasks/tasks-test.jsonl" - _ -> ".tasks/tasks.jsonl" + (_, Just "1") -> ".tasks/tasks-test.db" + _ -> ".tasks/tasks.db" pure path +-- DB Helper +withDb :: (SQL.Connection -> IO a) -> IO a +withDb action = do + dbPath <- getTasksDbPath + SQL.withConnection dbPath <| \conn -> do + SQL.execute_ conn "PRAGMA busy_timeout = 5000" + action conn + -- Initialize the task database initTaskDb :: IO () initTaskDb = do createDirectoryIfMissing True ".tasks" - tasksFile <- getTasksFilePath - exists <- doesFileExist tasksFile - unless exists <| do - TIO.writeFile tasksFile "" - putText <| "Initialized task database at " <> T.pack tasksFile - --- Lock for in-process thread safety -taskLock :: MVar () -taskLock = unsafePerformIO (newMVar ()) -{-# NOINLINE taskLock #-} - --- Execute action with write lock (exclusive) -withTaskWriteLock :: IO a -> IO a -withTaskWriteLock action = - withMVar taskLock <| \_ -> do - -- In test mode, we rely on MVar for thread safety to avoid GHC "resource busy" errors - -- when mixing openFd (flock) and standard IO in threaded tests. - testMode <- lookupEnv "TASK_TEST_MODE" - case testMode of - Just "1" -> action - _ -> do - tasksFile <- getTasksFilePath - let lockFile = tasksFile <> ".lock" - bracket - ( do - h <- IO.openFile lockFile IO.ReadWriteMode - handleToFd h - ) - closeFd - ( \fd -> do - waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0) - action - ) - --- Execute action with read lock (shared) -withTaskReadLock :: IO a -> IO a -withTaskReadLock action = - withMVar taskLock <| \_ -> do - testMode <- lookupEnv "TASK_TEST_MODE" - case testMode of - Just "1" -> action - _ -> do - tasksFile <- getTasksFilePath - let lockFile = tasksFile <> ".lock" - bracket - ( do - h <- IO.openFile lockFile IO.ReadWriteMode - handleToFd h - ) - closeFd - ( \fd -> do - waitToSetLock fd (ReadLock, AbsoluteSeek, 0, 0) - action - ) + withDb <| \conn -> do + SQL.execute_ + conn + "CREATE TABLE IF NOT EXISTS tasks (\ + \ id TEXT PRIMARY KEY, \ + \ title TEXT NOT NULL, \ + \ type TEXT NOT NULL, \ + \ parent TEXT, \ + \ namespace TEXT, \ + \ status TEXT NOT NULL, \ + \ priority TEXT NOT NULL, \ + \ dependencies TEXT NOT NULL, \ + \ description TEXT, \ + \ created_at TIMESTAMP NOT NULL, \ + \ updated_at TIMESTAMP NOT NULL \ + \)" -- Generate a short ID using base36 encoding of timestamp (lowercase) generateId :: IO Text generateId = do now <- getCurrentTime - -- Convert current time to microseconds since epoch (using MJD) let day = utctDay now dayTime = utctDayTime now mjd = toModifiedJulianDay day micros = diffTimeToPicoseconds dayTime `div` 1000000 - -- Combine MJD and micros to ensure uniqueness across days. - -- Multiplier 10^11 (100,000 seconds) is safe for any day length. totalMicros = (mjd * 100000000000) + micros encoded = toBase36 totalMicros pure <| "t-" <> T.pack encoded --- 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. +-- Generate a child ID based on parent ID generateChildId :: Text -> IO Text -generateChildId parentId = - withTaskReadLock <| do - tasks <- loadTasksInternal - pure <| computeNextChildId tasks (normalizeId parentId) +generateChildId parentId = do + tasks <- loadTasks + pure <| computeNextChildId tasks (normalizeId parentId) computeNextChildId :: [Task] -> Text -> Text computeNextChildId tasks parentId = - -- Find the max suffix among ALL tasks that look like children (to avoid ID collisions) - -- We check all tasks, not just those with taskParent set, because we want to ensure - -- ID uniqueness even if the parent link is missing. let suffixes = mapMaybe (getSuffix parentId <. taskId) tasks nextSuffix = case suffixes of [] -> 1 @@ -248,178 +282,104 @@ toBase36 n = reverse <| go n idx = fromIntegral r char = case drop idx alphabet of (c : _) -> c - [] -> '0' -- Fallback (should never happen) + [] -> '0' in char : go q --- Load all tasks from JSONL file (with migration support) +-- Load all tasks from DB loadTasks :: IO [Task] -loadTasks = withTaskReadLock loadTasksInternal - -loadTasksInternal :: IO [Task] -loadTasksInternal = do - tasksFile <- getTasksFilePath - exists <- doesFileExist tasksFile - if exists - then do - content <- TIO.readFile tasksFile - let taskLines = T.lines content - pure <| mapMaybe decodeTask taskLines - else pure [] - where - decodeTask :: Text -> Maybe Task - decodeTask line = - if T.null line - then Nothing - else case decode (BLC.pack <| T.unpack line) of - Just task -> Just task - Nothing -> migrateTask line - - -- Migrate old task formats to new format - migrateTask :: Text -> Maybe Task - migrateTask line = case Aeson.decode (BLC.pack <| T.unpack line) :: Maybe Aeson.Object of - Nothing -> Nothing - Just obj -> - let taskId' = KM.lookup "taskId" obj +> parseMaybe Aeson.parseJSON - taskTitle' = KM.lookup "taskTitle" obj +> parseMaybe Aeson.parseJSON - taskStatus' = KM.lookup "taskStatus" obj +> parseMaybe Aeson.parseJSON - taskCreatedAt' = KM.lookup "taskCreatedAt" obj +> parseMaybe Aeson.parseJSON - taskUpdatedAt' = KM.lookup "taskUpdatedAt" obj +> parseMaybe Aeson.parseJSON - - -- Extract taskDescription (new field) - taskDescription' = KM.lookup "taskDescription" obj +> parseMaybe Aeson.parseJSON - - -- Extract dependencies (handle V1 [Dependency] and V0 [Text]) - v1Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Dependency] - v0Deps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Text] - finalDeps = case v1Deps of - Just ds -> ds - Nothing -> case v0Deps of - Just ts -> map (\tid -> Dependency {depId = tid, depType = Blocks}) ts - Nothing -> [] - - -- taskProject is ignored in new format (use epics instead) - taskType' = fromMaybe WorkTask (KM.lookup "taskType" obj +> parseMaybe Aeson.parseJSON) - taskParent' = KM.lookup "taskParent" obj +> parseMaybe Aeson.parseJSON - taskNamespace' = KM.lookup "taskNamespace" obj +> parseMaybe Aeson.parseJSON - -- Default priority to P2 (medium) for old tasks - taskPriority' = fromMaybe P2 (KM.lookup "taskPriority" obj +> parseMaybe Aeson.parseJSON) - in case (taskId', taskTitle', taskStatus', taskCreatedAt', taskUpdatedAt') of - (Just tid, Just title, Just status, Just created, Just updated) -> - Just - Task - { taskId = tid, - taskTitle = title, - taskType = taskType', - taskParent = taskParent', - taskNamespace = taskNamespace', - taskStatus = status, - taskPriority = taskPriority', - taskDependencies = finalDeps, - taskDescription = taskDescription', - taskCreatedAt = created, - taskUpdatedAt = updated - } - _ -> Nothing - --- Save a single task (append to JSONL) -saveTask :: Task -> IO () -saveTask = withTaskWriteLock <. saveTaskInternal +loadTasks = + withDb <| \conn -> do + SQL.query_ conn "SELECT id, title, type, parent, namespace, status, priority, dependencies, description, created_at, updated_at FROM tasks" -saveTaskInternal :: Task -> IO () -saveTaskInternal task = do - tasksFile <- getTasksFilePath - let json = encode task - BLC.appendFile tasksFile (json <> "\n") +-- Save a single task (UPSERT) +saveTask :: Task -> IO () +saveTask task = + withDb <| \conn -> do + SQL.execute + conn + "INSERT OR REPLACE INTO tasks \ + \ (id, title, type, parent, namespace, status, priority, dependencies, description, created_at, updated_at) \ + \ VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" + task -- Create a new task createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> Priority -> [Dependency] -> Maybe Text -> IO Task -createTask title taskType parent namespace priority deps description = - withTaskWriteLock <| do - let parent' = fmap normalizeId parent - deps' = map normalizeDependency deps - - tid <- case parent' of - Nothing -> generateUniqueId - Just pid -> do - tasks <- loadTasksInternal - pure <| computeNextChildId tasks pid - now <- getCurrentTime - let task = - Task - { taskId = normalizeId tid, - taskTitle = title, - taskType = taskType, - taskParent = parent', - taskNamespace = namespace, - taskStatus = Open, - taskPriority = priority, - taskDependencies = deps', - taskDescription = description, - taskCreatedAt = now, - taskUpdatedAt = now - } - saveTaskInternal task - pure task - --- Generate a unique ID (checking against existing tasks) +createTask title taskType parent namespace priority deps description = do + let parent' = fmap normalizeId parent + deps' = map normalizeDependency deps + + tid <- case parent' of + Nothing -> generateUniqueId + Just pid -> do + tasks <- loadTasks + pure <| computeNextChildId tasks pid + now <- getCurrentTime + let task = + Task + { taskId = normalizeId tid, + taskTitle = title, + taskType = taskType, + taskParent = parent', + taskNamespace = namespace, + taskStatus = Open, + taskPriority = priority, + taskDependencies = deps', + taskDescription = description, + taskCreatedAt = now, + taskUpdatedAt = now + } + saveTask task + pure task + +-- Generate a unique ID generateUniqueId :: IO Text generateUniqueId = do - tasks <- loadTasksInternal - go tasks + -- We can query DB directly to check existence + go where - go tasks = do + go = do tid <- generateId - case findTask tid tasks of - Nothing -> pure tid - Just _ -> go tasks -- Retry if collision (case-insensitive) + exists <- + withDb <| \conn -> do + [SQL.Only c] <- SQL.query conn "SELECT COUNT(*) FROM tasks WHERE id = ?" (SQL.Only tid) :: IO [SQL.Only Int] + pure (c > 0) + if exists then go else pure tid -- Update task status updateTaskStatus :: Text -> Status -> [Dependency] -> IO () updateTaskStatus tid newStatus newDeps = - withTaskWriteLock <| do - tasks <- loadTasksInternal + withDb <| \conn -> do now <- getCurrentTime - let updatedTasks = map updateIfMatch tasks - updateIfMatch t = - if matchesId (taskId t) tid - then t {taskStatus = newStatus, taskUpdatedAt = now, taskDependencies = if null newDeps then taskDependencies t else newDeps} - else t - -- Rewrite the entire file (simple approach for MVP) - tasksFile <- getTasksFilePath - TIO.writeFile tasksFile "" - traverse_ saveTaskInternal updatedTasks - --- Edit a task by applying a modification function + -- If newDeps is empty, we need to preserve existing deps. + -- If newDeps is NOT empty, we replace them. + -- This logic is slightly tricky in SQL. We fetch first. + rows <- SQL.query conn "SELECT dependencies FROM tasks WHERE id = ?" (SQL.Only tid) :: IO [SQL.Only [Dependency]] + case rows of + [] -> pure () -- Task not found + (SQL.Only existingDeps : _) -> do + let finalDeps = if null newDeps then existingDeps else newDeps + SQL.execute + conn + "UPDATE tasks SET status = ?, updated_at = ?, dependencies = ? WHERE id = ?" + (newStatus, now, finalDeps, tid) + +-- Edit a task editTask :: Text -> (Task -> Task) -> IO Task -editTask tid modifyFn = - withTaskWriteLock <| do - tasks <- loadTasksInternal - now <- getCurrentTime - - -- Find the task first to ensure it exists - case findTask tid tasks of - Nothing -> panic "Task not found" - Just original -> do - let modified = modifyFn original - -- Only update timestamp if something actually changed - -- But for simplicity, we always update it if the user explicitly ran 'edit' - finalTask = modified {taskUpdatedAt = now} - - updateIfMatch t = - if matchesId (taskId t) tid - then finalTask - else t - updatedTasks = map updateIfMatch tasks - - -- Rewrite the entire file - tasksFile <- getTasksFilePath - TIO.writeFile tasksFile "" - traverse_ saveTaskInternal updatedTasks - pure finalTask - --- List tasks, optionally filtered by type, parent, status, or namespace +editTask tid modifyFn = do + tasks <- loadTasks + case findTask tid tasks of + Nothing -> panic "Task not found" + Just original -> do + now <- getCurrentTime + let modified = modifyFn original + finalTask = modified {taskUpdatedAt = now} + saveTask finalTask + pure finalTask + +-- List tasks listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task] listTasks maybeType maybeParent maybeStatus maybeNamespace = do + -- Implementing specific filters in SQL would be more efficient, but for MVP and API compat: tasks <- loadTasks let filtered = tasks @@ -438,20 +398,16 @@ listTasks maybeType maybeParent maybeStatus maybeNamespace = do filterByNamespace Nothing ts = ts filterByNamespace (Just ns) ts = filter (\t -> taskNamespace t == Just ns) ts --- Get ready tasks (not blocked by dependencies and not a parent) +-- Get ready tasks getReadyTasks :: IO [Task] getReadyTasks = do allTasks <- loadTasks - -- Only Open or InProgress tasks are considered ready for work. - -- Review tasks are waiting for review, and Done tasks are complete. let openTasks = filter (\t -> taskStatus t == Open || taskStatus t == InProgress) allTasks doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks - -- Find all tasks that act as parents parentIds = mapMaybe taskParent allTasks isParent tid = tid `elem` parentIds - -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady task = taskType task @@ -462,7 +418,7 @@ getReadyTasks = do /= HumanTask pure <| filter isReady openTasks --- Get dependency tree for a task (returns tasks) +-- Get dependency tree getDependencyTree :: Text -> IO [Task] getDependencyTree tid = do tasks <- loadTasks @@ -470,7 +426,6 @@ getDependencyTree tid = do Nothing -> pure [] Just task -> pure <| collectDeps tasks task where - collectDeps :: [Task] -> Task -> [Task] collectDeps allTasks task = let depIds = map depId (taskDependencies task) deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks @@ -480,8 +435,8 @@ getDependencyTree tid = do getTaskProgress :: Text -> IO TaskProgress getTaskProgress tidRaw = do let tid = normalizeId tidRaw + -- Could be SQL optimized tasks <- loadTasks - -- Verify task exists (optional, but good for error handling) case findTask tid tasks of Nothing -> panic "Task not found" Just _ -> do @@ -497,13 +452,11 @@ getTaskProgress tidRaw = do progressPercentage = percentage } --- Show task progress showTaskProgress :: Text -> IO () showTaskProgress tid = do progress <- getTaskProgress tid putText <| "Progress for " <> tid <> ": " <> T.pack (show (progressCompleted progress)) <> "/" <> T.pack (show (progressTotal progress)) <> " (" <> T.pack (show (progressPercentage progress)) <> "%)" --- Show dependency tree for a task showDependencyTree :: Text -> IO () showDependencyTree tid = do tasks <- loadTasks @@ -518,53 +471,42 @@ showDependencyTree tid = do deps = filter (\t -> any (matchesId (taskId t)) depIds) allTasks traverse_ (\dep -> printTree allTasks dep (indent + 1)) deps --- Get task tree (returns tasks hierarchically) getTaskTree :: Maybe Text -> IO [Task] getTaskTree maybeId = do tasks <- loadTasks case maybeId of Nothing -> do - -- Return all epics with their children let epics = filter (\t -> taskType t == Epic) tasks in pure <| concatMap (collectChildren tasks) epics Just tid -> do - -- Return specific task/epic with its children case findTask tid tasks of Nothing -> pure [] Just task -> pure <| collectChildren tasks task where - collectChildren :: [Task] -> Task -> [Task] collectChildren allTasks task = let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks in task : concatMap (collectChildren allTasks) children --- Show task tree (epic with children, or all epics if no ID given) showTaskTree :: Maybe Text -> IO () showTaskTree maybeId = do tasks <- loadTasks case maybeId of Nothing -> do - -- Show all epics with their children let epics = filter (\t -> taskType t == Epic) tasks if null epics then putText "No epics found" else traverse_ (printEpicTree tasks) epics Just tid -> do - -- Show specific task/epic with its children case findTask tid tasks of Nothing -> putText "Task not found" Just task -> printEpicTree tasks task where - printEpicTree :: [Task] -> Task -> IO () - printEpicTree allTasks task = printTreeNode allTasks task 0 + printEpicTree allTasks task = printTreeNode allTasks task (0 :: Int) - printTreeNode :: [Task] -> Task -> Int -> IO () printTreeNode allTasks task indent = printTreeNode' allTasks task indent [] - printTreeNode' :: [Task] -> Task -> Int -> [Bool] -> IO () printTreeNode' allTasks task indent ancestry = do let children = filter (maybe False (`matchesId` taskId task) <. taskParent) allTasks - -- Build tree prefix using box-drawing characters prefix = if indent == 0 then "" @@ -572,7 +514,6 @@ showTaskTree maybeId = do let ancestorPrefixes = map (\hasMore -> if hasMore then "│ " else " ") (List.init ancestry) myPrefix = if List.last ancestry then "├── " else "└── " in T.pack <| concat ancestorPrefixes ++ myPrefix - -- For epics, show progress count [completed/total]; for tasks, show status checkbox statusStr = case taskType task of Epic -> let total = length children @@ -602,7 +543,6 @@ showTaskTree maybeId = do Nothing -> "" Just _ -> gray nsStr - -- Calculate available width for title (80 cols - prefix - id - labels) usedWidth = T.length prefix + T.length (taskId task) + T.length statusStr + T.length nsStr + 2 availableWidth = max 20 (80 - usedWidth) truncatedTitle = @@ -614,7 +554,6 @@ showTaskTree maybeId = do putText <| prefix <> cyan (taskId task) <> " " <> coloredStatusStr <> " " <> coloredNsStr <> coloredTitle - -- Print children with updated ancestry let indexedChildren = zip [1 ..] children totalChildren = length children traverse_ @@ -624,7 +563,6 @@ showTaskTree maybeId = do ) indexedChildren --- Helper to print a task printTask :: Task -> IO () printTask t = do tasks <- loadTasks @@ -655,13 +593,10 @@ 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 @@ -678,7 +613,6 @@ printTask t = do <> coloredParent <> coloredNamespace --- Show detailed task information (human-readable) showTaskDetailed :: Task -> IO () showTaskDetailed t = do tasks <- loadTasks @@ -690,7 +624,6 @@ showTaskDetailed t = do putText <| "Status: " <> T.pack (show (taskStatus t)) putText <| "Priority: " <> T.pack (show (taskPriority t)) <> priorityDesc - -- Show epic progress if this is an epic when (taskType t == Epic) <| do let children = filter (maybe False (`matchesId` taskId t) <. taskParent) tasks total = length children @@ -707,19 +640,16 @@ showTaskDetailed t = do putText <| "Created: " <> T.pack (show (taskCreatedAt t)) putText <| "Updated: " <> T.pack (show (taskUpdatedAt t)) - -- Show dependencies unless (null (taskDependencies t)) <| do putText "" putText "Dependencies:" traverse_ printDependency (taskDependencies t) - -- Show description case taskDescription t of Nothing -> pure () Just desc -> do putText "" putText "Description:" - -- Indent description for better readability let indented = T.unlines <| map (" " <>) (T.lines desc) putText indented @@ -735,7 +665,6 @@ showTaskDetailed t = do printDependency dep = putText <| " - " <> depId dep <> " [" <> T.pack (show (depType dep)) <> "]" --- ANSI Colors red, green, yellow, blue, magenta, cyan, gray, bold :: Text -> Text red t = "\ESC[31m" <> t <> "\ESC[0m" green t = "\ESC[32m" <> t <> "\ESC[0m" @@ -746,17 +675,23 @@ cyan t = "\ESC[36m" <> t <> "\ESC[0m" gray t = "\ESC[90m" <> t <> "\ESC[0m" 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 - --- Task statistics +-- Export tasks: Dump SQLite to JSONL +exportTasks :: Maybe FilePath -> IO () +exportTasks maybePath = do + tasks <- loadTasks + case maybePath of + Just path -> do + TIO.writeFile path "" + traverse_ (saveTaskToJsonl path) tasks + Nothing -> + -- Stream to stdout + traverse_ (BLC.putStrLn <. encode) tasks + +saveTaskToJsonl :: FilePath -> Task -> IO () +saveTaskToJsonl path task = do + let json = encode task + BLC.appendFile path (json <> "\n") + data TaskStats = TaskStats { totalTasks :: Int, openTasks :: Int, @@ -776,7 +711,6 @@ instance ToJSON TaskStats instance FromJSON TaskStats --- Get task statistics getTaskStats :: Maybe Text -> IO TaskStats getTaskStats maybeEpicId = do allTasks <- loadTasks @@ -790,7 +724,6 @@ getTaskStats maybeEpicId = do globalReady <- getReadyTasks let readyIds = map taskId globalReady - -- Filter ready tasks to only include those in our target set readyCount = length <| filter (\t -> taskId t `elem` readyIds) targetTasks tasks = targetTasks @@ -803,7 +736,6 @@ getTaskStats maybeEpicId = do epics = length <| filter (\t -> taskType t == Epic) tasks readyCount' = readyCount blockedCount = total - readyCount' - done - -- Count tasks by priority byPriority = [ (P0, length <| filter (\t -> taskPriority t == P0) tasks), (P1, length <| filter (\t -> taskPriority t == P1) tasks), @@ -811,7 +743,6 @@ getTaskStats maybeEpicId = do (P3, length <| filter (\t -> taskPriority t == P3) tasks), (P4, length <| filter (\t -> taskPriority t == P4) tasks) ] - -- Count tasks by namespace namespaces = mapMaybe taskNamespace tasks uniqueNs = List.nub namespaces byNamespace = map (\ns -> (ns, length <| filter (\t -> taskNamespace t == Just ns) tasks)) uniqueNs @@ -830,13 +761,11 @@ getTaskStats maybeEpicId = do tasksByNamespace = byNamespace } --- Helper to get all descendants of a task (recursive) getAllDescendants :: [Task] -> Text -> [Task] getAllDescendants allTasks parentId = let children = filter (maybe False (`matchesId` parentId) <. taskParent) allTasks in children ++ concatMap (getAllDescendants allTasks <. taskId) children --- Show task statistics (human-readable) showTaskStats :: Maybe Text -> IO () showTaskStats maybeEpicId = do stats <- getTaskStats maybeEpicId @@ -876,48 +805,21 @@ showTaskStats maybeEpicId = do printNamespace (ns, count) = putText <| " " <> T.pack (show count) <> " " <> ns --- Import tasks: Read from another JSONL file and merge with existing tasks +-- Import tasks: Read from JSONL and insert/update DB 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 = map normalizeTask (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 = do + exists <- doesFileExist filePath + unless exists <| panic (T.pack filePath <> " does not exist") + + content <- TIO.readFile filePath + let importLines = T.lines content + importedTasks = map normalizeTask (mapMaybe decodeTask importLines) + + -- Save all imported tasks (UPSERT logic handles updates) + traverse_ saveTask importedTasks where decodeTask :: Text -> Maybe Task decodeTask line = if T.null line then Nothing else decode (BLC.pack <| T.unpack line) - - -- Update an existing task if there's a newer version in imported tasks - updateWithImported :: [Task] -> Task -> Task - updateWithImported imported existing = - case findTask (taskId existing) imported of - Nothing -> existing -- No imported version, keep existing - Just importedTask -> - -- Use imported version if it's newer (based on updatedAt) - if taskUpdatedAt importedTask > taskUpdatedAt existing - then importedTask - else existing |