{-# LANGUAGE OverloadedStrings #-}

-- | Mechanical claim gate for a free-agent bus root.
--
-- .claim-N files are the authority; the bus post is only the record.
-- Uses check-then-create — the race window is microseconds vs 30s LLM latency.
module Free.Agent.Bus.Claim
  ( -- * Claim operations
    claimTask,
    checkTask,
    releaseTask,
    listClaims,
    wipeClaims,

    -- * Paths
    claimPath,
  )
where

import Control.Monad (when)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import System.Directory (doesFileExist, listDirectory, removeFile)
import System.FilePath ((</>))

-- | Path to the claim lock file for a task.
claimPath :: FilePath -> Int -> FilePath
claimPath :: FilePath -> Int -> FilePath
claimPath FilePath
root Int
n = FilePath
root FilePath -> FilePath -> FilePath
</> (FilePath
".claim-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n)

-- | Claim task @n@ for @name@.  Returns 'True' on success, 'False' if
-- already claimed (file exists when we check).
claimTask :: FilePath -> Int -> Text -> IO Bool
claimTask :: FilePath -> Int -> Text -> IO Bool
claimTask FilePath
root Int
n Text
name = do
  let path :: FilePath
path = FilePath -> Int -> FilePath
claimPath FilePath
root Int
n
  e <- FilePath -> IO Bool
doesFileExist FilePath
path
  if e
    then do
      holder <- readHolder path
      TIO.putStrLn $ "task-" <> T.pack (show n) <> " held by " <> holder
      pure False
    else do
      TIO.writeFile path (name <> " 0")
      pure True

-- | Who holds task @n@?  Returns 'Nothing' if unclaimed.
checkTask :: FilePath -> Int -> IO (Maybe Text)
checkTask :: FilePath -> Int -> IO (Maybe Text)
checkTask FilePath
root Int
n = do
  let path :: FilePath
path = FilePath -> Int -> FilePath
claimPath FilePath
root Int
n
  e <- FilePath -> IO Bool
doesFileExist FilePath
path
  if not e
    then pure Nothing
    else Just <$> readHolder path

-- | Read the first word of a claim file (the holder name).
readHolder :: FilePath -> IO Text
readHolder :: FilePath -> IO Text
readHolder FilePath
path = do
  txt <- FilePath -> IO Text
TIO.readFile FilePath
path
  pure $ T.takeWhile (/= ' ') (T.strip txt)

-- | Release (delete) the claim on task @n@.
releaseTask :: FilePath -> Int -> IO ()
releaseTask :: FilePath -> Int -> IO ()
releaseTask FilePath
root Int
n = do
  let path :: FilePath
path = FilePath -> Int -> FilePath
claimPath FilePath
root Int
n
  e <- FilePath -> IO Bool
doesFileExist FilePath
path
  when e $ removeFile path

-- | List all current claims.  Returns @[(task number, holder)]@.
listClaims :: FilePath -> IO [(Int, Text)]
listClaims :: FilePath -> IO [(Int, Text)]
listClaims FilePath
root = do
  ents <- FilePath -> IO [FilePath]
listDirectory FilePath
root
  let claims = [FilePath
ent | FilePath
ent <- [FilePath]
ents, Text
".claim-" Text -> Text -> Bool
`T.isPrefixOf` FilePath -> Text
T.pack FilePath
ent]
  mapM
    ( \FilePath
ent -> do
        let n :: Int
n = FilePath -> Int
forall a. Read a => FilePath -> a
read (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
7 FilePath
ent)
        holder <- FilePath -> IO Text
readHolder (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
ent)
        pure (n, holder)
    )
    claims

-- | Remove all claim files in the bus root.
wipeClaims :: FilePath -> IO ()
wipeClaims :: FilePath -> IO ()
wipeClaims FilePath
root = do
  ents <- FilePath -> IO [FilePath]
listDirectory FilePath
root
  mapM_
    (\FilePath
ent -> FilePath -> IO ()
removeFile (FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
ent))
    [ent | ent <- ents, ".claim-" `T.isPrefixOf` T.pack ent]