{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} -- : out agent -- : dep temporary module Omni.Agent where import Alpha import qualified Data.Text as Text import qualified Data.Text.IO as TIO import qualified Omni.Agent.Core as Core import qualified Omni.Agent.Git as Git import qualified Omni.Agent.Log as Log import qualified Omni.Agent.Worker as Worker import qualified Omni.Cli as Cli import qualified Omni.Task.Core as TaskCore import qualified Omni.Test as Test import qualified System.Console.Docopt as Docopt import qualified System.Directory as Directory import qualified System.Environment as Env import qualified System.Exit as Exit import System.FilePath (takeFileName) import qualified System.IO as IO import qualified System.IO.Temp as Temp main :: IO () main = Cli.main plan plan :: Cli.Plan () plan = Cli.Plan { Cli.help = help, Cli.move = move, Cli.test = test, Cli.tidy = \_ -> pure () } help :: Cli.Docopt help = [Cli.docopt| agent Usage: agent start [] agent harvest [--path=] agent merge-driver agent test agent --help Options: --path= Path to the worker directory [default: .] --help Show this help |] move :: Cli.Arguments -> IO () move args | args `Cli.has` Cli.command "start" = do -- Always run in current directory let path = "." -- Infer name from current directory absPath <- Directory.getCurrentDirectory let name = Text.pack (takeFileName absPath) let worker = Core.Worker { Core.workerName = name, Core.workerPid = Nothing, Core.workerStatus = Core.Idle, Core.workerPath = path } let taskId = fmap Text.pack (Cli.getArg args (Cli.argument "task-id")) Worker.start worker taskId | args `Cli.has` Cli.command "harvest" = harvest args | args `Cli.has` Cli.command "merge-driver" = mergeDriver args | otherwise = putStrLn (Cli.usage help) getArgOrExit :: Cli.Arguments -> Docopt.Option -> IO String getArgOrExit args opt = case Cli.getArg args opt of Just val -> pure val Nothing -> do putText <| "Error: Missing required argument " <> Text.pack (show opt) Exit.exitFailure harvest :: Cli.Arguments -> IO () harvest args = do let path = Cli.getArgWithDefault args "." (Cli.longOption "path") putText "Harvesting task updates from workers..." branches <- Git.listBranches path "omni-worker-*" if null branches then putText "No worker branches found." else do updated <- foldlM (processBranch path) False branches when updated <| do -- Consolidate Directory.setCurrentDirectory path TaskCore.exportTasks -- Commit if changed Git.commit path "task: harvest updates from workers" putText "Success: Task database updated and committed." processBranch :: FilePath -> Bool -> Text -> IO Bool processBranch repo updated branch = do putText <| "Checking " <> branch <> "..." maybeContent <- Git.showFile repo branch ".tasks/tasks.jsonl" case maybeContent of Nothing -> do putText <| " Warning: Could not read .tasks/tasks.jsonl from " <> branch pure updated Just content -> do -- Write to temp file Temp.withSystemTempFile "worker-tasks.jsonl" <| \tempPath h -> do TIO.hPutStr h content IO.hClose h -- Import -- We need to ensure we are in the repo directory for TaskCore to find .tasks/tasks.jsonl Directory.setCurrentDirectory repo TaskCore.importTasks tempPath putText <| " Imported tasks from " <> branch pure True mergeDriver :: Cli.Arguments -> IO () mergeDriver args = do ours <- getArgOrExit args (Cli.argument "ours") theirs <- getArgOrExit args (Cli.argument "theirs") -- Set TASK_DB_PATH to ours (the file git provided as the current version) Env.setEnv "TASK_DB_PATH" ours TaskCore.importTasks theirs Exit.exitSuccess test :: Test.Tree test = Test.group "Omni.Agent" [unitTests, logTests] logTests :: Test.Tree logTests = Test.group "Log tests" [ Test.unit "Log.emptyStatus" <| do let s = Log.emptyStatus "worker-1" Log.statusWorker s Test.@?= "worker-1" Log.statusFiles s Test.@?= 0 ] unitTests :: Test.Tree unitTests = Test.group "Unit tests" [ Test.unit "can parse start command" <| do let result = Docopt.parseArgs help ["start"] case result of Left err -> Test.assertFailure <| "Failed to parse 'start': " <> show err Right args -> args `Cli.has` Cli.command "start" Test.@?= True, Test.unit "can parse start command with task id" <| do let result = Docopt.parseArgs help ["start", "t-123"] case result of Left err -> Test.assertFailure <| "Failed to parse 'start t-123': " <> show err Right args -> do args `Cli.has` Cli.command "start" Test.@?= True Cli.getArg args (Cli.argument "task-id") Test.@?= Just "t-123", Test.unit "can parse harvest command" <| do let result = Docopt.parseArgs help ["harvest"] case result of Left err -> Test.assertFailure <| "Failed to parse 'harvest': " <> show err Right args -> args `Cli.has` Cli.command "harvest" Test.@?= True ]