OS Model API Reference

-- | Unique identifier for any entity in the system.
newtype EntityId = EntityId { unEntityId :: UUID }
    deriving (Eq, Ord, Show, Hashable, FromJSON, ToJSON)

-- | Generate a new unique EntityId.
newEntityId :: IO EntityId

eid1 <- newEntityId  -- Unique ID
eid2 <- newEntityId  -- Different unique ID
assert (eid1 /= eid2)  -- True

newtype AgentId = AgentId { unAgentId :: EntityId }
newtype ToolboxId = ToolboxId { unToolboxId :: EntityId }
newtype ConversationId = ConversationId { unConversationId :: EntityId }
newtype TurnId = TurnId { unTurnId :: EntityId }
newtype ToolCallId = ToolCallId { unToolCallId :: EntityId }
newtype ResourceId = ResourceId { unResourceId :: EntityId }

eid <- newEntityId
let agentId = AgentId eid
let toolboxId = ToolboxId eid  -- Same underlying ID, different type

-- Type-safe: Can't mix up IDs
useAgent agentId       -- OK
useAgent toolboxId     -- Compile error!

-- | Type-level identifier for component types.
newtype ComponentTypeId = ComponentTypeId { unComponentTypeId :: Int }

-- | A component is any data type that can be attached to an entity.
class Component a where
    componentId :: Proxy a -> ComponentTypeId

data MyComponent = MyComponent
    { mcValue :: Int
    , mcName :: Text
    } deriving (Show, Eq, Generic)

instance FromJSON MyComponent
instance ToJSON MyComponent

-- Choose a unique ID (check existing IDs to avoid collisions)
instance Component MyComponent where
    componentId _ = ComponentTypeId 100

-- | The world contains all component stores.
newtype World = World { componentStores :: HashMap ComponentTypeId (TVar Any) }

-- | Create an empty world.
newWorld :: STM World

-- | Register a component store for a component type.
registerComponentStore :: (Component a, Typeable a) => World -> Proxy a -> STM World

import Data.Proxy (Proxy(..))

-- Create world with agent components
world <- atomically $ do
    w <- newWorld
    w' <- registerComponentStore w (Proxy @AgentConfig)
    w'' <- registerComponentStore w' (Proxy @AgentState)
    pure w''

-- | Create a new entity.
createEntity :: IO EntityId

-- | Check if an entity exists (has any component).
entityExists :: World -> EntityId -> STM Bool

-- | Get all entities with a specific component.
allEntitiesWithComponent :: (Component a, Typeable a) => World -> STM [EntityId]

eid <- createEntity
exists <- atomically $ entityExists world eid  -- False

atomically $ setComponent world eid (AgentConfig "test" ...)
exists' <- atomically $ entityExists world eid  -- True

-- Find all agents
agentIds <- atomically $ allEntitiesWithComponent @AgentConfig world

-- | Get a component for an entity.
getComponent :: (Component a, Typeable a) => World -> EntityId -> STM (Maybe a)

-- | Set a component for an entity.
setComponent :: (Component a, Typeable a) => World -> EntityId -> a -> STM ()

-- | Modify a component for an entity.
modifyComponent :: (Component a, Typeable a) => World -> EntityId -> (a -> a) -> STM ()

-- | Remove a component from an entity.
removeComponent :: (Component a, Typeable a) => World -> EntityId -> STM ()

-- | Check if an entity has a specific component.
hasComponent :: (Component a, Typeable a) => World -> EntityId -> STM Bool

-- Set component
atomically $ setComponent world eid AgentConfig
    { agentName = "my-agent"
    , agentModel = ModelConfig "openai" "..." "gpt-4" "key1"
    , agentSystemPrompt = "You are helpful"
    , agentToolboxBindings = []
    }

-- Get component
mConfig <- atomically $ getComponent @AgentConfig world eid
case mConfig of
    Nothing -> putStrLn "No agent config"
    Just config -> putStrLn $ "Agent: " ++ show config.agentName

-- Modify component
atomically $ modifyComponent @AgentConfig world eid $
    \c -> c { agentName = "renamed-agent" }

-- Check and remove
hasIt <- atomically $ hasComponent @AgentConfig world eid
when hasIt $ atomically $ removeComponent @AgentConfig world eid

data AgentConfig = AgentConfig
    { agentName :: Text                    -- ^ Human-readable name
    , agentModel :: ModelConfig            -- ^ LLM configuration
    , agentSystemPrompt :: Text            -- ^ System instructions
    , agentToolboxBindings :: [ToolboxBindingSpec]  -- ^ Bound toolboxes
    } deriving (Show, Eq, Generic)

data ModelConfig = ModelConfig
    { modelFlavor :: Text      -- ^ Provider (openai, mistral, etc.)
    , modelUrl :: Text         -- ^ API endpoint
    , modelName :: Text        -- ^ Model identifier
    , modelApiKeyId :: Text    -- ^ Key reference
    } deriving (Show, Eq, Generic)

data AgentState = AgentState
    { agentStatus :: AgentStatus           -- ^ Current status
    , agentCurrentConversation :: Maybe ConversationId
    , agentCreatedAt :: UTCTime
    } deriving (Show, Eq, Generic)

data AgentStatus
    = AgentIdle                           -- ^ Available for work
    | AgentBusy TurnId                    -- ^ Executing a turn
    | AgentError Text                     -- ^ Error state
    deriving (Show, Eq, Generic)

createAgent :: OS -> AgentConfig -> IO AgentId
createAgent os config = do
    eid <- createEntity
    now <- getCurrentTime
    
    atomically $ do
        setComponent (osWorld os) eid config
        setComponent (osWorld os) eid AgentState
            { agentStatus = AgentIdle
            , agentCurrentConversation = Nothing
            , agentCreatedAt = now
            }
    
    pure $ AgentId eid

-- Usage
let config = AgentConfig
    { agentName = "coder-agent"
    , agentModel = ModelConfig "openai" "https://api.openai.com/v1" "gpt-4" "openai-key"
    , agentSystemPrompt = "You are a helpful coding assistant"
    , agentToolboxBindings = []
    }
agentId <- createAgent os config

data ToolboxConfig = ToolboxConfig
    { toolboxName :: Text           -- ^ Human-readable name
    , toolboxType :: ToolboxType    -- ^ Type of toolbox
    , toolboxSettings :: Value      -- ^ Type-specific settings
    } deriving (Show, Eq, Generic)

data ToolboxType
    = ToolboxTypeBash
    | ToolboxTypeMCP
    | ToolboxTypeOpenAPI
    | ToolboxTypePostgREST
    | ToolboxTypeSqlite
    | ToolboxTypeSystem
    | ToolboxTypeDeveloper
    | ToolboxTypeLua
    | ToolboxTypeSkills
    deriving (Show, Eq, Generic)

data ToolboxState = ToolboxState
    { toolboxScope :: ResourceScope     -- ^ Resource lifetime scope
    , toolboxStatus :: ToolboxStatus    -- ^ Current status
    , toolboxResourceRef :: Maybe ResourceId  -- ^ Associated resource
    } deriving (Show, Eq, Generic)

data ToolboxStatus
    = ToolboxInitializing
    | ToolboxReady
    | ToolboxError Text
    | ToolboxDisposed
    deriving (Show, Eq, Generic)

data ResourceScope
    = ScopeGlobal                       -- ^ Global/program scope
    | ScopeAgent AgentId                -- ^ Per-agent scope
    | ScopeConversation ConversationId  -- ^ Per-conversation scope
    deriving (Show, Eq, Generic)

-- Create a bash toolbox
let bashConfig = ToolboxConfig
    { toolboxName = "bash-tools"
    , toolboxType = ToolboxTypeBash
    , toolboxSettings = object ["directory" .= "./tools"]
    }
bashId <- createToolbox os bashConfig

-- Create a SQLite toolbox
let sqliteConfig = ToolboxConfig
    { toolboxName = "memory-db"
    , toolboxType = ToolboxTypeSqlite
    , toolboxSettings = object 
        [ "path" .= "./memory.db"
        , "access" .= "readwrite"
        ]
    }
sqliteId <- createToolbox os sqliteConfig

-- Bind toolboxes to agent
let agentConfig = AgentConfig
    { ...
    , agentToolboxBindings = 
        [ unToolboxId bashId
        , unToolboxId sqliteId
        ]
    }

data ResourceType
    = SqliteResource SqliteConfig
    | LuaResource LuaConfig
    | HttpResource HttpConfig
    | CustomResource Text Value
    deriving (Show, Eq)

data ResourceHandle = ResourceHandle
    { handleId :: ResourceId
    , handleCleanup :: IO ()
    , handleAccess :: (ResourceAccessor -> IO a) -> IO a
    }

data ResourceInfo = ResourceInfo
    { resourceId :: ResourceId
    , resourceScope :: ResourceScope
    , resourceType :: ResourceType
    , resourceCreatedAt :: UTCTime
    }

data ResourceContext = ResourceContext
    { contextScope :: [ScopeLevel]      -- ^ Active scope path
    , contextRegistry :: ResourceRegistry
    }

data ScopeLevel
    = ProgramScope
    | AgentScope AgentId
    | ToolboxScope ToolboxId
    | ConversationScope ConversationId
    | TurnScope TurnId
    | ToolCallScope ToolCallId
    deriving (Show, Eq)

-- | Create a new resource.
createResource :: 
    ResourceContext -> 
    ResourceType -> 
    (ResourceId -> IO ResourceHandle) -> 
    IO ResourceId

-- | Cleanup all resources in a scope.
cleanupScope :: ResourceRegistry -> ScopeLevel -> IO ()

-- | Check if a resource is valid in given scopes.
isResourceValid :: ResourceScope -> [ScopeLevel] -> Bool

-- | Access a resource with a function.
withResource :: ResourceRegistry -> ResourceId -> (ResourceAccessor -> IO a) -> IO (Maybe a)

-- | Get total resource count.
getResourceCount :: ResourceRegistry -> IO Int

import System.Agents.OS.Resources

-- Create registry and context
registry <- atomically newResourceRegistry
let ctx = ResourceContext [ProgramScope] registry

-- Create SQLite resource
rid <- createResource ctx (SqliteResource config) $ \rid -> do
    conn <- openConnection config
    pure ResourceHandle
        { handleId = rid
        , handleCleanup = do
            putStrLn "Closing SQLite connection"
            closeConnection conn
        , handleAccess = \f -> f (SqliteAccessor conn)
        }

-- Use the resource
result <- withResource registry rid $ \accessor -> do
    case accessor of
        SqliteAccessor conn -> queryDatabase conn "SELECT * FROM table"

-- Later, cleanup all agent resources
cleanupScope registry (AgentScope agentId)

data AccessPattern
    = ExclusiveAccess      -- ^ Single accessor (TMVar)
    | ReadWriteAccess      -- ^ Multiple readers, single writer (RWLock)
    | PoolAccess Int       -- ^ Bounded pool (TBQueue)
    | StatelessAccess      -- ^ No synchronization needed
    deriving (Show, Eq)

data AccessControl = AccessControl
    { accessPattern :: AccessPattern
    , accessTimeout :: Maybe NominalDiffTime
    }

-- | Monad for resource operations.
newtype ResourceM a = ResourceM { unResourceM :: ReaderT ResourceContext (ExceptT ResourceError IO) a }
    deriving (Functor, Applicative, Monad, MonadIO)

-- | Run a ResourceM computation.
runResourceM :: ResourceContext -> ResourceM a -> IO (Either ResourceError a)

-- | Resource errors.
data ResourceError
    = ResourceNotFound ResourceId
    | ResourceBusy ResourceId
    | ResourceClosed ResourceId
    | ResourceAccessTimeout ResourceId NominalDiffTime
    | ResourceInvalidAccess ResourceId Text
    deriving (Show, Eq)

-- | Execute with exclusive access.
withExclusive :: ResourceId -> ResourceM a -> ResourceM a

-- | Execute with read access.
withRead :: ResourceId -> ResourceM a -> ResourceM a

-- | Execute with write access.
withWrite :: ResourceId -> ResourceM a -> ResourceM a

-- | Execute with pooled resource.
withPooled :: ResourceId -> ResourceM a -> ResourceM a

-- | Execute without synchronization.
withStateless :: ResourceId -> ResourceM a -> ResourceM a

import System.Agents.OS.Concurrent

-- SQLite with WAL mode (supports concurrent reads)
sqliteRid <- createSqliteResource ctx config True  -- WAL mode enabled

-- Multiple concurrent reads (safe)
forConcurrently_ [1..10] $ \_ -> do
    result <- runResourceM ctx $ withRead sqliteRid $ do
        queryData
    print result

-- Exclusive write (blocks readers)
runResourceM ctx $ withWrite sqliteRid $ do
    modifyData

-- Lua interpreter (requires exclusive access)
luaRid <- createLuaResource ctx config
result <- runResourceM ctx $ withExclusive luaRid $ do
    runScript "return 1 + 1"

-- HTTP connection pool
httpRid <- createHttpPool ctx 10  -- 10 connections
results <- forConcurrently urls $ \url ->
    runResourceM ctx $ withPooled httpRid $ do
        fetchUrl url

-- | Initialize access control.
initAccessControl :: AccessPattern -> Maybe NominalDiffTime -> AccessControl

-- | Initialize SQLite access (WAL mode flag).
initSqliteAccess :: Bool -> IO SqliteAccess

-- | Initialize Lua access.
initLuaAccess :: IO LuaAccess

-- | Initialize HTTP access.
initHttpAccess :: Int -> ResourceId -> IO HttpAccess

data ConversationConfig = ConversationConfig
    { conversationTitle :: Maybe Text
    , conversationMetadata :: Map Text Value
    } deriving (Show, Eq, Generic)

data ConversationState = ConversationState
    { conversationAgentId :: AgentId
    , conversationStatus :: ConversationStatus
    , conversationStartedAt :: UTCTime
    , conversationLastActivity :: TVar UTCTime
    } deriving (Generic)

data ConversationStatus
    = ConversationActive
    | ConversationPaused
    | ConversationCompleted
    | ConversationError Text
    deriving (Show, Eq, Generic)

data TurnConfig = TurnConfig
    { turnConversationId :: ConversationId
    , turnParentTurnId :: Maybe TurnId
    } deriving (Show, Eq, Generic)

data TurnState = TurnState
    { turnStatus :: TurnStatus
    , turnStartedAt :: UTCTime
    , turnCompletedAt :: Maybe UTCTime
    } deriving (Show, Eq, Generic)

data TurnStatus
    = TurnStarting
    | TurnProcessing
    | TurnWaitingForTools
    | TurnCompleted
    | TurnError Text
    deriving (Show, Eq, Generic)

data ToolCallConfig = ToolCallConfig
    { toolCallTurnId :: TurnId
    , toolCallParentId :: Maybe ToolCallId
    , toolCallName :: Text
    , toolCallInput :: Value
    } deriving (Show, Eq, Generic)

data ToolCallState = ToolCallState
    { toolCallStatus :: ToolCallStatus
    , toolCallResult :: Maybe Value
    , toolCallStartedAt :: UTCTime
    , toolCallCompletedAt :: Maybe UTCTime
    } deriving (Show, Eq, Generic)

data ToolCallStatus
    = ToolCallPending
    | ToolCallExecuting
    | ToolCallCompleted
    | ToolCallFailed Text
    deriving (Show, Eq, Generic)

data Lineage = Lineage { unLineage :: [LineageFrame] }
    deriving (Show, Eq)

data LineageFrame = LineageFrame
    { frameType :: FrameType
    , frameEntityId :: EntityId
    , frameTimestamp :: UTCTime
    } deriving (Show, Eq)

data FrameType
    = ProgramFrame
    | AgentFrame
    | ToolboxFrame
    | ConversationFrame
    | TurnFrame
    | ToolCallFrame
    deriving (Show, Eq, Enum, Bounded)

-- | Empty lineage.
emptyLineage :: Lineage

-- | Push a frame onto the lineage.
pushLineage :: FrameType -> EntityId -> UTCTime -> Lineage -> Lineage

-- | Get lineage depth.
lineageDepth :: Lineage -> Int

-- | Get the most recent frame.
lineageHead :: Lineage -> Maybe LineageFrame

-- | Get the oldest frame.
lineageRoot :: Lineage -> Maybe LineageFrame

-- | Build context from lineage.
buildLineageContext :: Lineage -> LineageContext

-- | Find frames by type.
findFramesByType :: FrameType -> Lineage -> [LineageFrame]

-- | Check if in specific context.
isInConversation :: Lineage -> Bool
isInTurn :: Lineage -> Bool
currentFrameType :: Lineage -> Maybe FrameType

import System.Agents.OS.Conversation

-- Create conversation
convId <- createEntity
now <- getCurrentTime
lastActivity <- newTVarIO now

atomically $ do
    setComponent world convId ConversationConfig
        { conversationTitle = Just "My Chat"
        , conversationMetadata = Map.empty
        }
    setComponent world convId ConversationState
        { conversationAgentId = agentId
        , conversationStatus = ConversationActive
        , conversationStartedAt = now
        , conversationLastActivity = lastActivity
        }

-- Create turn
turnId <- createEntity
atomically $ do
    setComponent world turnId TurnConfig
        { turnConversationId = convId
        , turnParentTurnId = Nothing
        }
    setComponent world turnId TurnState
        { turnStatus = TurnStarting
        , turnStartedAt = now
        , turnCompletedAt = Nothing
        }

-- Build lineage
let lineage = pushLineage ConversationFrame (unConversationId convId) now $
              pushLineage TurnFrame (unTurnId turnId) now $
              emptyLineage

-- Check depth
print $ lineageDepth lineage  -- 2

-- Find conversation frames
let convFrames = findFramesByType ConversationFrame lineage

-- | The single in-library event emission type.
data OSEmission
    = EmitSubcallStarted SessionId SessionId Text Int
      -- ^ Parent session id, child session id, the helper's slug, call depth.
    | EmitSubcallCompleted SessionId (Maybe Text)
      -- ^ Child session id, the subcall's result text (when it succeeded).
    | EmitSubcallFailed SessionId Text
      -- ^ Child session id, the failure message.
    | EmitToolCallActivity ToolCallActivity
    | EmitError Text
      -- ^ A hook (e.g. a before/after tool-call command hook) failed
      -- outside of the normal tool-call result path. Not a session
      -- failure: the run continues.
    deriving (Show)

toEventBody :: OSEmission -> EventBody
toEventBody = \case
    EmitSubcallStarted parent child slug depth -> SubcallStarted parent child slug depth
    EmitSubcallCompleted child result -> SubcallCompleted child result
    EmitSubcallFailed child msg -> SubcallFailed child msg
    EmitToolCallActivity activity -> ToolCallProgressed activity
    EmitError msg -> HookFailed msg

import System.Agents.OS.Events (newQueueEmitter, OSEmission (..))

(queue, emitter) <- newQueueEmitter
let agent' = agent{ctxEmit = Just emitter}
-- ... run agent' ...
emissions <- atomically $ flushTQueue queue

data ToolExecutionContext = ToolExecutionContext
    { -- ... existing fields ...
    , ctxWorld :: Maybe World
    -- ^ Optional OS World for ECS operations. When present, subcalls
    -- can insert entities and components into the OS.
    , ctxEmit :: Maybe (OSEmission -> IO ())
    -- ^ Optional emission hook. When present, subcalls emit events to
    -- notify a runner (or other local consumer) of their lifecycle.
    , ctxParentConversation :: Maybe ConversationId
    -- ^ Optional parent conversation ID for subcalls. When present,
    -- indicates this context is for a nested agent invocation.
    }

-- | Get the subcall depth (0 if not a subcall).
getSubcallDepth :: ToolExecutionContext -> Int

-- | Check if this context represents a subcall.
isSubcallContext :: ToolExecutionContext -> Bool

-- | Create a nested context for subcall execution.
mkSubcallContext ::
    ToolExecutionContext ->
    Maybe World ->
    ConversationId ->
    ToolExecutionContext

createFullAgent :: OS -> Text -> [ToolboxId] -> IO AgentId
createFullAgent os name toolboxes = do
    let config = AgentConfig
        { agentName = name
        , agentModel = ModelConfig "openai" "..." "gpt-4" "key"
        , agentSystemPrompt = "You are helpful"
        , agentToolboxBindings = map unToolboxId toolboxes
        }
    createAgent os config

-- Usage
bashTb <- createToolbox os bashConfig
sqlTb <- createToolbox os sqliteConfig
httpTb <- createToolbox os httpConfig

agentId <- createFullAgent os "multi-tool-agent" [bashTb, sqlTb, httpTb]

forkConversation :: World -> ConversationId -> IO ConversationId
forkConversation world convId = do
    -- Get original config
    Just config <- atomically $ getComponent @ConversationConfig world (unConversationId convId)
    
    -- Create new conversation
    newConvId <- createEntity
    now <- getCurrentTime
    lastActivity <- newTVarIO now
    
    atomically $ do
        setComponent world newConvId config
        setComponent world newConvId ConversationState
            { conversationAgentId = ...
            , conversationStatus = ConversationActive
            , conversationStartedAt = now
            , conversationLastActivity = lastActivity
            }
    
    -- Copy turn history
    turns <- getConversationTurns world convId
    forM_ turns $ \turnId -> do
        Just turnConfig <- atomically $ getComponent @TurnConfig world (unTurnId turnId)
        newTurnId <- createEntity
        atomically $ setComponent world newTurnId turnConfig
            { turnConversationId = ConversationId newConvId
            }
    
    pure $ ConversationId newConvId

withPooledTimeout :: ResourceContext -> ResourceId -> NominalDiffTime -> ResourceM a -> ResourceM a
withPooledTimeout ctx rid timeout action = do
    currentTimeout <- getResourceTimeout rid
    -- Temporarily set timeout
    updateResourceTimeout rid (Just timeout)
    result <- withPooled rid action
    -- Restore original timeout
    updateResourceTimeout rid currentTimeout
    pure result

updateAgentAndToolbox :: World -> AgentId -> ToolboxId -> AgentConfig -> ToolboxConfig -> STM ()
updateAgentAndToolbox world agentId toolboxId agentConfig toolboxConfig = do
    -- Both updates happen atomically
    setComponent world (unAgentId agentId) agentConfig
    setComponent world (unToolboxId toolboxId) toolboxConfig

-- Usage
atomically $ updateAgentAndToolbox world agentId toolboxId newAgentConfig newToolboxConfig