path: root/Omni/Task/Core.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

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.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, parent, status, or namespace
listTasks :: Maybe TaskType -> Maybe Text -> Maybe Status -> Maybe Text -> IO [Task]
listTasks maybeType maybeParent maybeStatus maybeNamespace = do
  tasks <- loadTasks
  let filtered =
        tasks
          |> filterByType maybeType
          |> filterByParent maybeParent
          |> filterByStatus maybeStatus
          |> filterByNamespace maybeNamespace
  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
    filterByStatus Nothing ts = ts
    filterByStatus (Just status) ts = filter (\t -> taskStatus t == status) ts
    filterByNamespace Nothing ts = ts
    filterByNamespace (Just ns) ts = filter (\t -> taskNamespace t == Just ns) 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

-- 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 filter (\t -> taskId t == tid) tasks of
        [] -> putText "Task not found"
        (task : _) -> printEpicTree tasks task
  where
    printEpicTree :: [Task] -> Task -> IO ()
    printEpicTree allTasks task = printTreeNode allTasks task 0

    printTreeNode :: [Task] -> Task -> Int -> IO ()
    printTreeNode allTasks task indent = do
      let prefix = T.pack (replicate (indent * 2) ' ')
          -- Only show type label for epics
          typeStr = case taskType task of
            Epic -> "[Epic] "
            WorkTask -> ""
          statusStr = case taskStatus task of
            Open -> "[ ]"
            InProgress -> "[~]"
            Done -> "[✓]"
          nsStr = case taskNamespace task of
            Nothing -> ""
            Just ns -> "[" <> ns <> "] "
          -- Calculate available width for title (80 cols - prefix - id - labels)
          usedWidth = T.length prefix + T.length (taskId task) + T.length typeStr + T.length statusStr + T.length nsStr + 2
          availableWidth = max 20 (80 - usedWidth)
          truncatedTitle =
            if T.length (taskTitle task) > availableWidth
              then T.take (availableWidth - 3) (taskTitle task) <> "..."
              else taskTitle task
      putText <| prefix <> taskId task <> " " <> typeStr <> statusStr <> " " <> nsStr <> truncatedTitle

      -- Find and print children (tasks with this task as parent)
      let children = filter (\t -> taskParent t == Just (taskId task)) allTasks
      traverse_ (\child -> printTreeNode allTasks child (indent + 1)) children

-- 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