{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Omni.Task.Core where import Alpha import Control.Monad ((>>=)) 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.Text as T import qualified Data.Text.IO as TIO import Data.Time (UTCTime, diffTimeToPicoseconds, getCurrentTime, utctDayTime) import GHC.Generics () import System.Directory (createDirectoryIfMissing, doesFileExist) import System.Environment (lookupEnv) -- Core data types data Task = Task { taskId :: Text, taskTitle :: Text, taskType :: TaskType, taskParent :: Maybe Text, -- Parent epic ID taskNamespace :: Maybe Text, -- Optional namespace (e.g., "Omni/Task", "Biz/Cloud") taskStatus :: Status, taskDependencies :: [Dependency], -- List of dependencies with types taskCreatedAt :: UTCTime, taskUpdatedAt :: UTCTime } deriving (Show, Eq, Generic) data TaskType = Epic | WorkTask deriving (Show, Eq, Generic) data Status = Open | InProgress | Done deriving (Show, Eq, Generic) data Dependency = Dependency { depId :: Text, -- ID of the task this depends on depType :: DependencyType -- Type of dependency relationship } deriving (Show, Eq, Generic) data DependencyType = Blocks -- Hard dependency, blocks ready work queue | DiscoveredFrom -- Work discovered during other work | ParentChild -- Epic/subtask relationship | Related -- Soft relationship, doesn't block deriving (Show, Eq, Generic) instance ToJSON TaskType instance FromJSON TaskType instance ToJSON Status instance FromJSON Status instance ToJSON DependencyType instance FromJSON DependencyType instance ToJSON Dependency instance FromJSON Dependency instance ToJSON Task instance FromJSON Task -- Get the tasks database file path (use test file if TASK_TEST_MODE is set) getTasksFilePath :: IO FilePath getTasksFilePath = do testMode <- lookupEnv "TASK_TEST_MODE" pure <| case testMode of Just "1" -> ".tasks/tasks-test.jsonl" _ -> ".tasks/tasks.jsonl" -- 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 -- Generate a short ID using base62 encoding of timestamp generateId :: IO Text generateId = do now <- getCurrentTime -- Convert current time to microseconds since midnight let dayTime = utctDayTime now microseconds = diffTimeToPicoseconds dayTime `div` 1000000 -- Convert to base62 for shorter IDs encoded = toBase62 (fromIntegral microseconds) pure <| "t-" <> T.pack encoded -- Convert number to base62 (0-9, a-z, A-Z) toBase62 :: Integer -> String toBase62 0 = "0" toBase62 n = reverse <| go n where alphabet = ['0' .. '9'] ++ ['a' .. 'z'] ++ ['A' .. 'Z'] go 0 = [] go x = let (q, r) = x `divMod` 62 idx = fromIntegral r char = case drop idx alphabet of (c : _) -> c [] -> '0' -- Fallback (should never happen) in char : go q -- Load all tasks from JSONL file (with migration support) loadTasks :: IO [Task] loadTasks = 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 -> migrateOldTask line -- Migrate old task format (with taskProject field) to new format migrateOldTask :: Text -> Maybe Task migrateOldTask 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 old taskDependencies (could be [Text] or [Dependency]) oldDeps = KM.lookup "taskDependencies" obj +> parseMaybe Aeson.parseJSON :: Maybe [Text] newDeps = maybe [] (map (\tid -> Dependency {depId = tid, depType = Blocks})) oldDeps -- taskProject is ignored in new format (use epics instead) taskType' = WorkTask -- Old tasks become WorkTask by default taskParent' = Nothing taskNamespace' = KM.lookup "taskNamespace" 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, taskDependencies = newDeps, taskCreatedAt = created, taskUpdatedAt = updated } _ -> Nothing -- Save a single task (append to JSONL) saveTask :: Task -> IO () saveTask task = do tasksFile <- getTasksFilePath let json = encode task BLC.appendFile tasksFile (json <> "\n") -- Create a new task createTask :: Text -> TaskType -> Maybe Text -> Maybe Text -> [Dependency] -> IO Task createTask title taskType parent namespace deps = do tid <- generateId now <- getCurrentTime let task = Task { taskId = tid, taskTitle = title, taskType = taskType, taskParent = parent, taskNamespace = namespace, taskStatus = Open, taskDependencies = deps, taskCreatedAt = now, taskUpdatedAt = now } saveTask task pure task -- Update task status updateTaskStatus :: Text -> Status -> IO () updateTaskStatus tid newStatus = do tasks <- loadTasks now <- getCurrentTime let updatedTasks = map updateIfMatch tasks updateIfMatch t = if 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_ saveTask updatedTasks -- List tasks, optionally filtered by type or parent listTasks :: Maybe TaskType -> Maybe Text -> IO [Task] listTasks maybeType maybeParent = do tasks <- loadTasks let filtered = tasks |> filterByType maybeType |> filterByParent maybeParent pure filtered where filterByType Nothing ts = ts filterByType (Just typ) ts = filter (\t -> taskType t == typ) ts filterByParent Nothing ts = ts filterByParent (Just pid) ts = filter (\t -> taskParent t == Just pid) ts -- Get ready tasks (not blocked by dependencies) getReadyTasks :: IO [Task] getReadyTasks = do allTasks <- loadTasks let openTasks = filter (\t -> taskStatus t /= Done) allTasks doneIds = map taskId <| filter (\t -> taskStatus t == Done) allTasks -- Only Blocks and ParentChild dependencies block ready work blockingDepIds task = [depId dep | dep <- taskDependencies task, depType dep `elem` [Blocks, ParentChild]] isReady task = all (`elem` doneIds) (blockingDepIds task) pure <| filter isReady openTasks -- Show dependency tree for a task showDependencyTree :: Text -> IO () showDependencyTree tid = do tasks <- loadTasks case filter (\t -> taskId t == tid) tasks of [] -> putText "Task not found" (task : _) -> printTree tasks task 0 where printTree :: [Task] -> Task -> Int -> IO () printTree allTasks task indent = do putText <| T.pack (replicate (indent * 2) ' ') <> taskId task <> ": " <> taskTitle task let depIds = map depId (taskDependencies task) deps = filter (\t -> taskId t `elem` depIds) allTasks traverse_ (\dep -> printTree allTasks dep (indent + 1)) deps -- Helper to print a task printTask :: Task -> IO () printTask t = putText <| taskId t <> " [" <> T.pack (show (taskType t)) <> "] [" <> T.pack (show (taskStatus t)) <> "] " <> taskTitle t <> parentInfo <> namespaceInfo where parentInfo = case taskParent t of Nothing -> "" Just p -> " (parent: " <> p <> ")" namespaceInfo = case taskNamespace t of Nothing -> "" Just ns -> " [" <> ns <> "]" -- Export tasks: Consolidate JSONL file (remove duplicates, keep latest version) exportTasks :: IO () exportTasks = do tasks <- loadTasks -- Rewrite the entire file with deduplicated tasks tasksFile <- getTasksFilePath TIO.writeFile tasksFile "" traverse_ saveTask tasks -- Import tasks: Read from another JSONL file and merge with existing tasks importTasks :: FilePath -> IO () importTasks filePath = 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 <- loadTasks -- 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 -> taskId t `notElem` 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_ saveTask allTasks 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 filter (\t -> taskId t == taskId existing) imported of [] -> existing -- No imported version, keep existing (importedTask : _) -> -- Use imported version if it's newer (based on updatedAt) if taskUpdatedAt importedTask > taskUpdatedAt existing then importedTask else existing