commit bd23ef658f117e79a720d719095bd4858163f106
Author: Coder Agent <coder@agents.omni>
Date: Thu Feb 19 08:13:33 2026
feat(prompt): add compose operation and composition conventions
Task-Id: t-396
diff --git a/Omni/Agent/Prompt/Compile.hs b/Omni/Agent/Prompt/Compile.hs
index 471ca96a..102fafc0 100644
--- a/Omni/Agent/Prompt/Compile.hs
+++ b/Omni/Agent/Prompt/Compile.hs
@@ -15,11 +15,20 @@
-- : out prompt-compile
-- : dep aeson
-- : dep time
+-- : dep free
module Omni.Agent.Prompt.Compile
( -- * Compilation
compile,
compileWithBudget,
+ -- * Composition (Conventions)
+ PromptComponent (..),
+ PromptOp,
+ OpF (..),
+ composePrompt,
+ runPromptOp,
+ composeComponents,
+
-- * Output Types
CompiledPrompt (..),
PromptMessage (..),
@@ -37,6 +46,7 @@ module Omni.Agent.Prompt.Compile
where
import Alpha
+import Control.Monad.Free (Free (..), liftF)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import qualified Data.List as List
@@ -128,6 +138,75 @@ instance Aeson.ToJSON CompileMeta where
"compile_time" .= cmCompileTime cm
]
+-- * Composition (Conventions)
+
+-- | Prompt components with explicit compositional intent.
+--
+-- Conventions:
+-- - 'System' is the hyperprior (global behavior frame)
+-- - 'Skill' is a conditional prior (capability activated by context)
+-- - 'Message' is an observation/posterior sample in conversation order
+-- - 'Context' is supplemental context that is appended in order
+data PromptComponent
+ = System Text
+ | Skill Text
+ | Message PromptMessage
+ | Context Text
+ deriving (Show, Eq, Generic)
+
+-- | Free-monad operations for prompt composition.
+--
+-- Compose combines two prompt fragments with predictable conventions.
+-- The right-hand side can override system behavior while preserving
+-- additive/contextual information from both sides.
+data OpF next
+ = Compose [PromptComponent] [PromptComponent] ([PromptComponent] -> next)
+
+instance Functor OpF where
+ fmap f (Compose left right k) = Compose left right (f <. k)
+
+-- | Free monad over prompt composition operations.
+type PromptOp = Free OpF
+
+-- | Compose two prompt fragments using the conventions in 'composeComponents'.
+composePrompt :: [PromptComponent] -> [PromptComponent] -> PromptOp [PromptComponent]
+composePrompt left right = liftF (Compose left right identity)
+
+-- | Run prompt composition operations.
+runPromptOp :: PromptOp a -> IO a
+runPromptOp (Pure a) = pure a
+runPromptOp (Free (Compose left right k)) =
+ runPromptOp (k (composeComponents left right))
+
+-- | Deterministic prompt composition conventions.
+--
+-- Rules:
+-- 1. System prompt (hyperprior): right-biased override (last one wins)
+-- 2. Skills (conditional priors): concatenate with separators
+-- 3. Context chunks: append in order
+-- 4. Messages (observations/posterior samples): append in order
+--
+-- Order sensitivity:
+-- - System is intentionally order-sensitive (A <> B selects B's system)
+-- - Skills/context/messages preserve left-to-right concatenation order
+composeComponents :: [PromptComponent] -> [PromptComponent] -> [PromptComponent]
+composeComponents left right =
+ let combined = left <> right
+ chosenSystem = case reverse [content | System content <- combined] of
+ (sys : _) -> Just sys
+ [] -> Nothing
+ allSkills = [content | Skill content <- combined]
+ mergedSkills =
+ if null allSkills
+ then []
+ else [Skill (Text.intercalate "\n\n---\n\n" allSkills)]
+ allContext = [Context content | Context content <- combined]
+ allMessages = [Message msg | Message msg <- combined]
+ in maybeToList (System </ chosenSystem)
+ <> mergedSkills
+ <> allContext
+ <> allMessages
+
-- * Compilation
-- | Compile a PromptIR to flat message format.
@@ -432,5 +511,26 @@ test =
}
schema = formatToolSchema tool
tsName schema Test.@=? "test_tool"
- tsDescription schema Test.@=? "A test tool"
+ tsDescription schema Test.@=? "A test tool",
+ Test.unit "composePrompt combines two skills with separators" <| do
+ let left = [Skill "Analyze carefully"]
+ right = [Skill "Write comprehensive tests"]
+ composed <- runPromptOp (composePrompt left right)
+ composed Test.@=? [Skill "Analyze carefully\n\n---\n\nWrite comprehensive tests"],
+ Test.unit "composePrompt applies system override precedence" <| do
+ let left = [System "Base system"]
+ right = [System "Override system"]
+ composed <- runPromptOp (composePrompt left right)
+ composed Test.@=? [System "Override system"],
+ Test.unit "composePrompt appends context chunks in order" <| do
+ let left = [Context "project: omni"]
+ right = [Context "task: t-396"]
+ composed = composeComponents left right
+ contexts = [ctx | Context ctx <- composed]
+ contexts Test.@=? ["project: omni", "task: t-396"],
+ Test.unit "composePrompt preserves message order" <| do
+ let userMsg = PromptMessage "user" "Please help"
+ assistantMsg = PromptMessage "assistant" "Sure"
+ composed = composeComponents [Message userMsg] [Message assistantMsg]
+ composed Test.@=? [Message userMsg, Message assistantMsg]
]