agentic 0.2.0.3 → 0.2.0.4

raw patch · 14 files changed

+290/−251 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• README.md +10/−6
• agentic.cabal +4/−1
• src/Agentic/Contract.hs +86/−83
• src/Agentic/Core.hs +7/−9
• src/Agentic/Describe.hs +42/−42
• src/Agentic/Interpret.hs +23/−23
• src/Agentic/Questions.hs +20/−20
• src/Agentic/Runtime.hs +22/−11
• src/Agentic/Schema.hs +10/−10
• src/Agentic/Scripted.hs +2/−2
• src/Agentic/ViaLLM.hs +4/−4
• test/Portable.hs +18/−18
• test/Spec.hs +22/−22

@@ -1,5 +1,25 @@ # Changelog for agentic +## 0.2.0.4 - 2026-10-06++* Record fields are no longer functions: the packages are written with+  `DuplicateRecordFields`, `NoFieldSelectors` and `OverloadedRecordDot`, so+  read a field with record dot (`c.schema`, `map (.label) opts`). Flows that+  read the library's records need `OverloadedRecordDot`, and ones that build+  records with shared field names need `DuplicateRecordFields`.+* Fields lose the prefixes that only kept them unique. `Codec`'s `codecSchema`+  is `schema`; `ObjectCodec`, `Case`, `Option`, `OptionSet`, `Field`,+  `Variant`, `Note`, `ToolInfo`, `FlowGraph`, `Edge`, `Choice`, `Score`,+  `JudgeRequest`, `ToolSpec`, `ToolCall`, `Event`, and `StepInfo`'s+  `DraftInfo` and `JudgeInfo` drop theirs the same way (`caseTag` is `tag`,+  `edgeFrom` is `from`, `requestInput` is `input`). `Instruction`'s field is+  `text`, and `SystemOne`'s and `SystemTwo`'s are both `ask`. `ToolCall`+  keeps `callId`: a field named `id` clashes with the Prelude's under MicroHs.+* `reschema` changes a codec's schema. `c {schema = ...}` is ambiguous now+  that `Field` has a `schema` too.+* `inParallel` and `failWith` use a runtime's `parallel` and `failure`, which+  record dot can't select because they're polymorphic.+ ## 0.2.0.3 - 2026-10-06  * `fromBasisPoints` is renamed `toProbability`, the inverse of `probability`:

@@ -124,21 +124,25 @@ ```haskell instance Contract Joke where   contract = record "A joke, split into its parts" $ Joke-    <$> required "genre"     "The style of joke, e.g. pun, dad joke"  genre-    <*> required "setup"     "The setup line"                         setup-    <*> required "punchline" "The line that lands it; no explanation" punchline+    <$> required "genre"     "The style of joke, e.g. pun, dad joke"  (.genre)+    <*> required "setup"     "The setup line"                         (.setup)+    <*> required "punchline" "The line that lands it; no explanation" (.punchline)  instance Contract BetterJoke where   contract = sumOf "A joke in one of several shapes"     [ constructor "DadJoke" "A setup and a groan-worthy punchline" isDadJoke $-        DadJoke <$> required "setup" "" setup <*> required "punchline" "" punchline+        DadJoke <$> required "setup" "" (.setup) <*> required "punchline" "" (.punchline)     , constructor "OneLiner" "A single line" isOneLiner $-        OneLiner <$> required "line" "" line+        OneLiner <$> required "line" "" (.line)     , constructor "KnockKnock" "The classic call-and-response" isKnockKnock $-        KnockKnock <$> required "whosThere" "" whosThere <*> required "punchline" "" punchline ]+        KnockKnock <$> required "whosThere" "" (.whosThere) <*> required "punchline" "" (.punchline) ] ```  (Or derive it and add descriptions after: `genericContract & field "punchline" "..."`.)++The getters are `(.genre)` and friends because everything here, the library+included, is written with `DuplicateRecordFields`, `NoFieldSelectors` and+`OverloadedRecordDot`.  Contracts compile to the providers' native structured outputs and strict tool schemas, not to prompt text, so a reply that doesn't match the schema basically

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               agentic-version:            0.2.0.3+version:            0.2.0.4 synopsis:           Composable, inspectable agentic workflows mixing LLMs and Jev description:   Typed agentic workflows built from Arrow combinators. A flow is a description: you can describe it as a tree, Mermaid or Graphviz before running anything, then interpret it against System One (Jev) and System Two (an LLM) providers. This is the core: flows, contracts, questions, the runtime and the interpreter. It depends only on base and text.@@ -30,8 +30,11 @@     DefaultSignatures     DeriveAnyClass     DerivingVia+    DuplicateRecordFields     GADTs     LambdaCase+    NoFieldSelectors+    OverloadedRecordDot     OverloadedStrings     RankNTypes   ghc-options:      -Wall -Wno-name-shadowing

@@ -7,13 +7,14 @@ -- Generic deriving (@deriving (Generic, Contract)@ and -- @deriving (Generic, Options)@) is GHC only: MicroHs's "GHC.Generics" has no -- metadata classes to read names from. Under MicroHs, write contracts out--- with 'record', 'required', 'sumOf' and 'constructor', and options with--- 'option'.+-- with 'record', 'Agentic.Contract.required', 'sumOf' and 'constructor', and+-- options with 'option'. module Agentic.Contract   ( -- * Codecs     Codec (..)   , Contract (..)   , mapCodec+  , reschema     -- * Records   , ObjectCodec   , record@@ -66,7 +67,7 @@ -- Codecs  data Codec a = Codec-  { codecSchema :: Schema+  { schema :: Schema   , encode :: a -> Value   , decode :: Value -> Either Text a   }@@ -79,8 +80,13 @@ #endif  mapCodec :: (a -> b) -> (b -> a) -> Codec a -> Codec b-mapCodec to' from' c = Codec (codecSchema c) (encode c . from') (fmap to' . decode c)+mapCodec to' from' c = Codec c.schema (c.encode . from') (fmap to' . c.decode) +-- | Change a codec's schema. (A record update can't do this: t'Field' has a+-- @schema@ too, so @c {schema = ...}@ is ambiguous.)+reschema :: (Schema -> Schema) -> Codec a -> Codec a+reschema f (Codec s e d) = Codec (f s) e d+ primitive :: Shape -> (a -> Value) -> (Value -> Either Text a) -> Codec a primitive s = Codec (schemaOf s) @@ -119,10 +125,10 @@   contract =     let c = contract @a      in Codec-          (schemaOf (SArray (codecSchema c)))-          (Array . map (encode c))+          (schemaOf (SArray c.schema))+          (Array . map c.encode)           ( \case-              Array vs -> traverse (decode c) vs+              Array vs -> traverse c.decode vs               v -> mismatch "a list" v           ) @@ -130,11 +136,11 @@   contract =     let c = contract @a      in Codec-          (schemaOf (SNullable (codecSchema c)))-          (maybe Null (encode c))+          (schemaOf (SNullable c.schema))+          (maybe Null c.encode)           ( \case               Null -> Right Nothing-              v -> Just <$> decode c v+              v -> Just <$> c.decode v           )  instance (Contract a, Contract b) => Contract (a, b) where@@ -154,26 +160,26 @@ -- Records  -- | The fields of an object: encodes an @i@, decodes an @o@. Build one--- applicatively with 'required', then close it with 'record'.+-- applicatively with 'Agentic.Contract.required', then close it with 'record'. data ObjectCodec i o = ObjectCodec-  { objectFields :: [Field]-  , objectEncode :: i -> [(Text, Value)]-  , objectDecode :: [(Text, Value)] -> Either Text o+  { fields :: [Field]+  , encode :: i -> [(Text, Value)]+  , decode :: [(Text, Value)] -> Either Text o   }  instance Functor (ObjectCodec i) where-  fmap f o = o {objectDecode = fmap f . objectDecode o}+  fmap f (ObjectCodec fs e d) = ObjectCodec fs e (fmap f . d)  instance Applicative (ObjectCodec i) where   pure x = ObjectCodec [] (const []) (const (Right x))   f <*> x =     ObjectCodec-      (objectFields f <> objectFields x)-      (\i -> objectEncode f i <> objectEncode x i)-      (\kvs -> objectDecode f kvs <*> objectDecode x kvs)+      (f.fields <> x.fields)+      (\i -> f.encode i <> x.encode i)+      (\kvs -> f.decode kvs <*> x.decode kvs)  lmapObject :: (j -> i) -> ObjectCodec i o -> ObjectCodec j o-lmapObject g o = o {objectEncode = objectEncode o . g}+lmapObject g (ObjectCodec fs e d) = ObjectCodec fs (e . g) d  -- | A described field, using the field type's contract. required :: Contract a => Text -> Text -> (r -> a) -> ObjectCodec r a@@ -184,16 +190,16 @@ requiredWith name d c get =   ObjectCodec     [Field name schema (not nullable)]-    (\r -> [(name, encode c (get r))])+    (\r -> [(name, c.encode (get r))])     ( \kvs -> case lookupField name kvs of-        Just v -> prefix (decode c v)+        Just v -> prefix (c.decode v)         Nothing-          | nullable -> prefix (decode c Null)+          | nullable -> prefix (c.decode Null)           | otherwise -> Left ("missing field " <> name)     )   where-    schema = maybe id documentedSchema d (codecSchema c)-    nullable = case shape (codecSchema c) of+    schema = maybe id documentedSchema d c.schema+    nullable = case c.schema.shape of       SNullable _ -> True       _ -> False     prefix = either (\e -> Left (name <> ": " <> e)) Right@@ -206,10 +212,10 @@ record :: Text -> ObjectCodec a a -> Codec a record d o =   Codec-    (documentedSchema' (nonEmpty d) (schemaOf (SObject (objectFields o))))-    (Object . objectEncode o)+    (documentedSchema' (nonEmpty d) (schemaOf (SObject o.fields)))+    (Object . o.encode)     ( \case-        Object kvs -> objectDecode o kvs+        Object kvs -> o.decode kvs         v -> mismatch "an object" v     ) @@ -218,11 +224,11 @@  -- | One constructor of a sum type. data Case a = Case-  { caseTag :: Text-  , caseDoc :: Maybe Text-  , caseFields :: [Field]-  , caseEncode :: a -> Maybe [(Text, Value)]-  , caseDecode :: [(Text, Value)] -> Either Text a+  { tag :: Text+  , doc :: Maybe Text+  , fields :: [Field]+  , encode :: a -> Maybe [(Text, Value)]+  , decode :: [(Text, Value)] -> Either Text a   }  -- | A constructor: its tag, a description, how to recognise it, and its fields.@@ -233,9 +239,9 @@   Case     tag     (nonEmpty d)-    (objectFields o)-    (\a -> if matches a then Just (objectEncode o a) else Nothing)-    (objectDecode o)+    o.fields+    (\a -> if matches a then Just (o.encode a) else Nothing)+    o.decode  -- | A sum type. If no constructor has fields, it's encoded as an enumeration of -- tags; otherwise each value is an object with a @tag@ field.@@ -244,52 +250,51 @@  sumCodec :: Maybe Text -> [Case a] -> Codec a sumCodec d cases-  | all (null . caseFields) cases =+  | all (null . (.fields)) cases =       Codec-        (documentedSchema' d (schemaOf (SEnum [(caseTag c, caseDoc c) | c <- cases])))-        (\a -> maybe Null (String . caseTag) (matching a))+        (documentedSchema' d (schemaOf (SEnum [(c.tag, c.doc) | c <- cases])))+        (\a -> maybe Null (String . (.tag)) (matching a))         ( \case-            String t | Just c <- byTag t -> caseDecode c []-            v -> mismatch ("one of " <> T.intercalate ", " (map caseTag cases)) v+            String t | Just c <- byTag t -> c.decode []+            v -> mismatch ("one of " <> T.intercalate ", " (map (.tag) cases)) v         )   | otherwise =       Codec-        (documentedSchema' d (schemaOf (SSum [Variant (caseTag c) (caseDoc c) (caseFields c) | c <- cases])))-        ( \a -> case [(caseTag c, kvs) | c <- cases, Just kvs <- [caseEncode c a]] of+        (documentedSchema' d (schemaOf (SSum [Variant c.tag c.doc c.fields | c <- cases])))+        ( \a -> case [(c.tag, kvs) | c <- cases, Just kvs <- [c.encode a]] of             (t, kvs) : _ -> Object (("tag", String t) : kvs)             [] -> Null         )         ( \case             Object kvs               | Just (String t) <- lookupField "tag" kvs ->-                  maybe (Left ("unknown tag " <> t)) (`caseDecode` kvs) (byTag t)+                  maybe (Left ("unknown tag " <> t)) (\c -> c.decode kvs) (byTag t)             v -> mismatch "an object with a tag" v         )   where-    matching a = find (\c -> isJust (caseEncode c a)) cases-    byTag t = find ((== t) . caseTag) cases+    matching a = find (\c -> isJust (c.encode a)) cases+    byTag t = find ((== t) . (.tag)) cases  -- --------------------------------------------------------------------------- -- Adjusting contracts  -- | Describe the whole type. documented :: Text -> Codec a -> Codec a-documented d c = c {codecSchema = documentedSchema d (codecSchema c)}+documented d = reschema (documentedSchema d)  -- | Describe one field of a record (or of any constructor of a sum). Naming a -- field that doesn't exist is an error when the schema is first used. field :: Text -> Text -> Codec a -> Codec a-field name d c = c {codecSchema = s {shape = update (shape s)}}+field name d = reschema (\s -> s {shape = update s.shape})   where-    s = codecSchema c     update = \case       SObject fs | any named fs -> SObject (map describeField fs)-      SSum vs | any (any named . variantFields) vs ->-        SSum [v {variantFields = map describeField (variantFields v)} | v <- vs]+      SSum vs | any (any named . (.fields)) vs ->+        SSum [Variant t vd (map describeField vfs) | Variant t vd vfs <- vs]       _ -> error ("Agentic.Contract.field: no field named " <> T.unpack name)-    named f = fieldName f == name-    describeField f-      | named f = f {fieldSchema = documentedSchema d (fieldSchema f)}+    named f = f.name == name+    describeField f@(Field n s r)+      | named f = Field n (documentedSchema d s) r       | otherwise = f  -- | A constraint the wire schemas can't express. It's stated to the model and@@ -297,12 +302,14 @@ checked :: Text -> (a -> Bool) -> Codec a -> Codec a checked rule ok c =   Codec-    ((codecSchema c) {checks = checks (codecSchema c) <> [rule]})-    (encode c)+    (s {checks = s.checks <> [rule]})+    c.encode     ( \v -> do-        a <- decode c v+        a <- c.decode v         if ok a then Right a else Left ("must be " <> rule)     )+  where+    s = c.schema  between :: (Ord a, Show a) => a -> a -> Codec a -> Codec a between lo hi =@@ -333,18 +340,18 @@ instance (Datatype d, GCases f) => GContract (M1 D d f) where   gcontract = named $ mapCodec M1 unM1 $ case gcases @f of     [GCase _ (Just bare)] -> bare-    [GCase c Nothing] | not (null (caseFields c)) -> recordFromCase c-    cs -> sumCodec Nothing (map gcase cs)+    [GCase c Nothing] | not (null c.fields) -> recordFromCase c+    cs -> sumCodec Nothing (map (.gcase) cs)     where-      named c = c {codecSchema = titled (T.pack (datatypeName (undefined :: M1 D d f ()))) (codecSchema c)}+      named = reschema (titled (T.pack (datatypeName (undefined :: M1 D d f ()))))  recordFromCase :: Case a -> Codec a recordFromCase c =   Codec-    (schemaOf (SObject (caseFields c)))-    (Object . fromMaybe [] . caseEncode c)+    (schemaOf (SObject c.fields))+    (Object . fromMaybe [] . c.encode)     ( \case-        Object kvs -> caseDecode c kvs+        Object kvs -> c.decode kvs         v -> mismatch "an object" v     ) @@ -361,17 +368,13 @@     <> map (inject R1 (\case R1 x -> Just x; L1 _ -> Nothing)) (gcases @g)     where       inject :: (x -> y) -> (y -> Maybe x) -> GCase x -> GCase y-      inject wrap unwrap (GCase c _) =-        GCase-          c { caseEncode = \y -> unwrap y >>= caseEncode c-            , caseDecode = fmap wrap . caseDecode c-            }-          Nothing+      inject wrap unwrap (GCase (Case t d fs e dec) _) =+        GCase (Case t d fs (\y -> unwrap y >>= e) (fmap wrap . dec)) Nothing  instance (Constructor c, GFields f) => GCases (M1 C c f) where   gcases =     [ GCase-        (Case tag Nothing (objectFields o) (Just . objectEncode o) (objectDecode o))+        (Case tag Nothing o.fields (Just . o.encode) o.decode)         (mapCodec M1 unM1 <$> gbare @f)     ]     where@@ -410,14 +413,14 @@ -- Enumerations  data Option a = Option-  { optionValue :: a-  , optionLabel :: Text-  , optionDoc :: Maybe Text+  { value :: a+  , label :: Text+  , doc :: Maybe Text   }  data OptionSet a = OptionSet-  { optionsDoc :: Maybe Text-  , optionList :: [Option a]+  { doc :: Maybe Text+  , options :: [Option a]     -- ^ In order. For a score, this is the level order, lowest first.   } @@ -427,12 +430,12 @@   options :: OptionSet a #ifndef __MHS__   default options :: (Generic a, GEnum (Rep a), Show a) => OptionSet a-  options = OptionSet Nothing [Option v (label v) Nothing | v <- map to (genum @(Rep a))]+  options = OptionSet Nothing [Option v (showLabel v) Nothing | v <- map to (genum @(Rep a))] #endif  -- | One option, labelled by 'show' (the constructor's name, for an enumeration). option :: Show a => a -> Text -> Option a-option v d = Option v (label v) (nonEmpty d)+option v d = Option v (showLabel v) (nonEmpty d)  -- | Options with a description of the whole set. documentedOptions :: Text -> [Option a] -> OptionSet a@@ -440,8 +443,8 @@  -- | An option's label: what the model sees and answers with. For an -- enumeration, 'show' gives the constructor's name.-label :: Show a => a -> Text-label = T.pack . show+showLabel :: Show a => a -> Text+showLabel = T.pack . show  -- | Use with @deriving via@ to give an 'Options' type a matching 'Contract': --@@ -455,15 +458,15 @@ enumeration :: forall a. (Options a, Eq a) => Codec a enumeration =   Codec-    (documentedSchema' (optionsDoc set) (schemaOf (SEnum [(optionLabel o, optionDoc o) | o <- opts])))-    (\a -> maybe Null (String . optionLabel) (find ((== a) . optionValue) opts))+    (documentedSchema' set.doc (schemaOf (SEnum [(o.label, o.doc) | o <- opts])))+    (\a -> maybe Null (String . (.label)) (find ((== a) . (.value)) opts))     ( \case-        String t | Just o <- find ((== t) . optionLabel) opts -> Right (optionValue o)-        v -> mismatch ("one of " <> T.intercalate ", " (map optionLabel opts)) v+        String t | Just o <- find ((== t) . (.label)) opts -> Right o.value+        v -> mismatch ("one of " <> T.intercalate ", " (map (.label) opts)) v     )   where     set = options @a-    opts = optionList set+    opts = set.options  #ifndef __MHS__ class GEnum (f :: Type -> Type) where

@@ -29,7 +29,7 @@   , module Control.Arrow   ) where -import Agentic.Contract (Codec (..), Contract (..))+import Agentic.Contract (Codec (..), Contract (..), reschema) import Agentic.Questions (Probability, Questions, YesNo (..)) import Control.Arrow import qualified Control.Category as Category@@ -41,7 +41,7 @@ import Data.Proxy (Proxy (..))  -- | What a model step is asked to do.-newtype Instruction = Instruction {instructionText :: Text}+newtype Instruction = Instruction {text :: Text}   deriving (Eq, Ord, Show)  instance IsString Instruction where@@ -50,8 +50,8 @@ -- | A name, and optionally a description, for a sub-flow. Notes are for whoever -- is watching the flow, not for the model. data Note = Note-  { noteName :: Text-  , noteDescription :: Maybe Text+  { name :: Text+  , description :: Maybe Text   }   deriving (Eq, Ord, Show) @@ -135,9 +135,7 @@  -- | A type's contract, with its schema named after the type if it isn't already. titledContract :: forall a. (Contract a, Typeable a) => Codec a-titledContract = c {codecSchema = titled (T.pack (show (typeRep (Proxy @a)))) (codecSchema c)}-  where-    c = contract @a+titledContract = reschema (titled (T.pack (show (typeRep (Proxy @a))))) (contract @a)  -- | Map a flow over a list. The runtime may run the items concurrently. each :: Agentic m a b -> Agentic m [a] [b]@@ -174,7 +172,7 @@ keep p q =   note ("keep " <> T.pack (show p)) "" $     each (returnA &&& judge q)-      >>> arr (map fst . filter ((>= p) . yes . snd))+      >>> arr (map fst . filter ((>= p) . (.yes) . snd))  -- | Send the input 'Right' if the probability of yes is at least @p@, and -- 'Left' otherwise.@@ -182,4 +180,4 @@ gate p q =   note ("gate " <> T.pack (show p)) "" $     (returnA &&& judge q)-      >>> arr (\(x, a) -> if yes a >= p then Right x else Left x)+      >>> arr (\(x, a) -> if a.yes >= p then Right x else Left x)

@@ -47,22 +47,22 @@   | Effect     -- ^ @act@: plain code with an effect.   | DraftInfo-      { draftInstruction :: Instruction-      , draftInput :: Schema-      , draftOutput :: Schema-      , draftTools :: [ToolInfo]+      { instruction :: Instruction+      , input :: Schema+      , output :: Schema+      , tools :: [ToolInfo]       }   | JudgeInfo-      { judgeInput :: Schema-      , judgeQuestions :: [QuestionSpec]+      { input :: Schema+      , questions :: [QuestionSpec]       }  data ToolInfo = ToolInfo-  { infoName :: Text-  , infoDescription :: Text-  , infoInput :: Schema-  , infoOutput :: Schema-  , infoBody :: Description+  { name :: Text+  , description :: Text+  , input :: Schema+  , output :: Schema+  , body :: Description   }  -- | Describe a flow. This never runs anything.@@ -92,12 +92,12 @@   Arr _ -> Glue   Act _ -> Effect   Draft input out instruction tools ->-    DraftInfo instruction (codecSchema input) (codecSchema out) (map toolInfo tools)-  Judge input qs -> JudgeInfo (codecSchema input) (specs qs)+    DraftInfo instruction input.schema out.schema (map toolInfo tools)+  Judge input qs -> JudgeInfo input.schema qs.specs  toolInfo :: Tool m -> ToolInfo toolInfo (Tool name description input out body) =-  ToolInfo name description (codecSchema input) (codecSchema out) (describe body)+  ToolInfo name description input.schema out.schema (describe body)  -- --------------------------------------------------------------------------- -- The tree view@@ -140,11 +140,11 @@   ForEach d -> case branch seen d of     (seen', [Node "together" ts]) -> (seen', [Node "each" ts])     (seen', ts) -> (seen', [Node "each" ts])-  Annotated n (Leaf info) | not (passes (Leaf info)) -> leaf (Just (noteName n)) info+  Annotated n (Leaf info) | not (passes (Leaf info)) -> leaf (Just n.name) info   Annotated n d -> case trees seen d of-    (seen', [Node t cs]) -> (seen', [Node (noteName n <> "  " <> t) cs])-    (seen', []) -> (seen', [Node (noteName n) []])-    (seen', ts) -> (seen', [Node (noteName n) ts])+    (seen', [Node t cs]) -> (seen', [Node (n.name <> "  " <> t) cs])+    (seen', []) -> (seen', [Node n.name []])+    (seen', ts) -> (seen', [Node n.name ts])   where     -- A step: what kind it is, then its name, then the details.     leaf name info =@@ -162,10 +162,10 @@       (s', []) -> (s', [Node (if passes d then "pass" else "arr") []])       r -> r     toolTree s t-      | infoName t `elem` s = (s, Node ("tool " <> infoName t <> "  (see above)") [])-      | otherwise = case trees (infoName t : s) (infoBody t) of-          (s', [Node body cs]) -> (s', Node ("tool " <> infoName t <> "  " <> body) cs)-          (s', ts) -> (s', Node ("tool " <> infoName t) ts)+      | t.name `elem` s = (s, Node ("tool " <> t.name <> "  (see above)") [])+      | otherwise = case trees (t.name : s) t.body of+          (s', [Node body cs]) -> (s', Node ("tool " <> t.name <> "  " <> body) cs)+          (s', ts) -> (s', Node ("tool " <> t.name) ts)     labelled l = \case       [Node t cs] -> Node (l <> " → " <> t) cs       [] -> Node (l <> " → pass") []@@ -205,8 +205,8 @@ -- @repeatUntil@ and named sub-flows as boxes; tools hanging off their draft. -- 'mermaid' and 'dot' render it. data FlowGraph = FlowGraph-  { graphItems :: [Item]-  , graphEdges :: [Edge]+  { items :: [Item]+  , edges :: [Edge]   }  -- | A node, or a box of items.@@ -219,18 +219,18 @@ data NodeKind = Terminal | StepNode | ToolNode  data Edge = Edge-  { edgeFrom :: Text-  , edgeTo :: Text+  { from :: Text+  , to :: Text     -- ^ A node, or a box's id.-  , edgeLabel :: Maybe Text-  , edgeStyle :: EdgeStyle+  , label :: Maybe Text+  , style :: EdgeStyle   }  data EdgeStyle = Flow | Uses | Again  -- | The flow's graph, from @input@ to @output@. flowGraph :: Description -> FlowGraph-flowGraph d = case runBuild flow (BuildState 0 [[]] []) of+flowGraph d = case flow.runBuild (BuildState 0 [[]] []) of   (_, BuildState _ open edges) -> FlowGraph (reverse (concat open)) (reverse edges)   where     flow = do@@ -259,7 +259,7 @@   Build f <*> Build g = Build (\s -> let (h, s1) = f s; (a, s2) = g s1 in (h a, s2))  instance Monad Build where-  Build g >>= k = Build (\s -> let (a, s1) = g s in runBuild (k a) s1)+  Build g >>= k = Build (\s -> let (a, s1) = g s in (k a).runBuild s1)  fresh :: Build Text fresh = Build (\(BuildState n open es) -> ("n" <> T.pack (show n), BuildState (n + 1) open es))@@ -279,7 +279,7 @@ entriesSince :: Int -> [Text] -> Build [Text] entriesSince before sources = Build $ \s@(BuildState _ _ es) ->   let new = reverse (take (length es - before) es)-   in (nubOrdered [edgeTo e | e <- new, edgeFrom e `elem` sources], s)+   in (nubOrdered [e.to | e <- new, e.from `elem` sources], s)   where     nubOrdered = foldr (\x acc -> x : filter (/= x) acc) [] @@ -325,7 +325,7 @@     mapM_ (\(e, _) -> mapM_ (\t -> edge (Edge e t (Just "again") Again)) targets) exits     pure exits   Annotated n (Leaf info) | not (passes (Leaf info)) -> step (Just n) info-  Annotated n f -> snd <$> box (noteName n : maybe [] pure (noteDescription n)) (build InSequence from f)+  Annotated n f -> snd <$> box (n.name : maybe [] pure n.description) (build InSequence from f)   where     labelled l = [(f, Just l) | (f, _) <- from]     chain acc = \case@@ -334,7 +334,7 @@     -- A step's node, labelled by 'stepLines', with any tools hanging off it.     -- In a diagram, a named step's description goes under its name.     step note' info = do-      let lines'' = case (stepLines (noteName <$> note') info, note' >>= noteDescription) of+      let lines'' = case (stepLines ((.name) <$> note') info, note' >>= (.description)) of             (kind : name : details, Just description) -> kind : name : description : details             (ls, _) -> ls       exits <- node from lines''@@ -343,7 +343,7 @@           mapM_             ( \t -> do                 n <- fresh-                item (ItemNode n ToolNode ["tool " <> infoName t])+                item (ItemNode n ToolNode ["tool " <> t.name])                 mapM_ (\(e, _) -> edge (Edge e n Nothing Uses)) exits             )             tools@@ -359,7 +359,7 @@       Identity -> ("pass", [])       Glue -> ("arr", [])       Effect -> ("act", [])-      DraftInfo instruction _ out _ -> ("draft @" <> typeLabel out, [quoted (instructionText instruction)])+      DraftInfo instruction _ out _ -> ("draft @" <> typeLabel out, [quoted instruction.text])       JudgeInfo _ [q] -> ("judge", [questionText q])       JudgeInfo _ qs -> ("judge " <> T.pack (show (length qs)) <> " questions in one request", map questionText qs) @@ -461,8 +461,8 @@   Repeated d -> node "repeat" [("step", descriptionValue d)]   Annotated n d ->     node "note" $-      [("name", String (noteName n))]-        <> maybe [] (\t -> [("description", String t)]) (noteDescription n)+      [("name", String n.name)]+        <> maybe [] (\t -> [("description", String t)]) n.description         <> [("step", descriptionValue d)]   where     node kind fields = Object (("kind", String kind) : fields)@@ -473,7 +473,7 @@       DraftInfo instruction input out tools ->         node           "draft"-          [ ("instruction", String (instructionText instruction))+          [ ("instruction", String instruction.text)           , ("input", String (typeLabel input))           , ("output", String (typeLabel out))           , ("tools", Array (map tool tools))@@ -482,10 +482,10 @@         node "judge" [("input", String (typeLabel input)), ("questions", Array (map question qs))]     tool t =       Object-        [ ("name", String (infoName t))-        , ("description", String (infoDescription t))-        , ("input", String (typeLabel (infoInput t)))-        , ("output", String (typeLabel (infoOutput t)))+        [ ("name", String t.name)+        , ("description", String t.description)+        , ("input", String (typeLabel t.input))+        , ("output", String (typeLabel t.output))         ]     question = \case       AskYesNo q -> Object [("type", String "yesNo"), ("question", String q)]

@@ -18,26 +18,26 @@       Step s -> step path s x       Seq f g -> go path f x >>= go path g       Fanout f g -> do-        results <- parallel rt [Left <$> go path f x, Right <$> go path g x]+        results <- inParallel rt [Left <$> go path f x, Right <$> go path g x]         case results of           [Left b, Right c] -> pure (b, c)           _ -> error "Agentic.interpret: the runtime's parallel changed its results"       First f -> case x of (a, c) -> (\b -> (b, c)) <$> go path f a       Split f g -> case x of         (a, c) -> do-          results <- parallel rt [Left <$> go path f a, Right <$> go path g c]+          results <- inParallel rt [Left <$> go path f a, Right <$> go path g c]           case results of             [Left b, Right d] -> pure (b, d)             _ -> error "Agentic.interpret: the runtime's parallel changed its results"       Choose f g -> either (go path f) (go path g) x-      Each f -> parallel rt (map (go path f) x)+      Each f -> inParallel rt (map (go path f) x)       Repeat done f ->         let loop a = if done a then pure a else go path f a >>= loop          in loop x       Noted n f -> go (path <> [n]) f x      emit :: [Note] -> Happened -> m ()-    emit path = observe rt . Event path+    emit path = rt.observe . Event path      step :: forall a b. [Note] -> Step m a b -> a -> m b     step path s x = case s of@@ -46,10 +46,10 @@       Arr f -> pure (f x)       Act f -> emit path Acted >> f x       Judge input qs-        | null (specs qs) -> answered (decodeAnswers qs [])+        | null qs.specs -> answered (decodeAnswers qs [])         | otherwise -> do-            let request = JudgeRequest (encode input x) (specs qs)-            answers <- askSystemOne (systemOne rt) request+            let request = JudgeRequest (input.encode x) qs.specs+            answers <- rt.systemOne.ask request             emit path (Judged request answers)             answered (decodeAnswers qs answers)       Draft inCodec out instruction tools -> do@@ -57,39 +57,39 @@               Conversation                 { path = path                 , instruction = instruction-                , input = encode inCodec x-                , inputSchema = codecSchema inCodec+                , input = inCodec.encode x+                , inputSchema = inCodec.schema                 , tools = map toolSpec tools-                , outputSchema = codecSchema out+                , outputSchema = out.schema                 , history = []                 }         emit path (Drafting conversation)         let loop past = do-              turn <- askSystemTwo (systemTwo rt) conversation {history = past}+              turn <- rt.systemTwo.ask conversation {history = past}               emit path (Turned turn)-              case action turn of-                Respond v -> case decode out v of+              case turn.action of+                Respond v -> case out.decode v of                   Right b -> pure b                   Left problem -> do                     emit path (OutputRejected problem)-                    loop (past <> [Rejected (raw turn) problem])+                    loop (past <> [Rejected turn.raw problem])                 CallTools calls -> do-                  results <- parallel rt (map (runTool path tools) calls)-                  loop (past <> [Called (raw turn) (zip (map callId calls) results)])+                  results <- inParallel rt (map (runTool path tools) calls)+                  loop (past <> [Called turn.raw (zip (map (.callId) calls) results)])         loop []       where-        answered = either (failure rt . MalformedAnswers) pure+        answered = either (failWith rt . MalformedAnswers) pure      runTool :: [Note] -> [Tool m] -> ToolCall -> m ToolResult     runTool path tools call = do       emit path (ToolCalled call)-      result <- case find ((== callName call) . toolName) tools of-        Nothing -> pure (ToolFailed ("there is no tool named " <> callName call))-        Just (Tool name _ input out body) -> case decode input (callInput call) of+      result <- case find ((== call.name) . toolName) tools of+        Nothing -> pure (ToolFailed ("there is no tool named " <> call.name))+        Just (Tool name _ input out body) -> case input.decode call.input of           Left problem -> pure (ToolFailed ("invalid input: " <> problem))-          Right i -> ToolOk . encode out <$> go (path <> [Note name Nothing]) body i-      emit path (ToolReturned (callId call) result)+          Right i -> ToolOk . out.encode <$> go (path <> [Note name Nothing]) body i+      emit path (ToolReturned call.callId result)       pure result  toolSpec :: Tool m -> ToolSpec-toolSpec (Tool name description input _ _) = ToolSpec name description (codecSchema input)+toolSpec (Tool name description input _ _) = ToolSpec name description input.schema

@@ -78,16 +78,16 @@  data Choice a = Choice   { chosen :: a-  , choiceProbabilities :: [(a, Probability)]-  , choiceConfidence :: Probability+  , probabilities :: [(a, Probability)]+  , confidence :: Probability   }   deriving (Eq, Show)  data Score a = Score   { position :: Double     -- ^ The probability-weighted position, from 0 (the first option) upwards.-  , scoreProbabilities :: [(a, Probability)]-  , scoreConfidence :: Probability+  , probabilities :: [(a, Probability)]+  , confidence :: Probability   }   deriving (Eq, Show) @@ -97,23 +97,23 @@   contract = mapCodec toProbability probability (contract @Double)  instance Contract YesNo where-  contract = record "A yes/no judgement" (YesNo <$> required "yes" "The probability that the answer is yes" yes)+  contract = record "A yes/no judgement" (YesNo <$> required "yes" "The probability that the answer is yes" (.yes))  instance Contract a => Contract (Choice a) where   contract =     record "A choice between options" $       Choice-        <$> required "chosen" "The most likely option" chosen-        <*> required "probabilities" "Each option's probability" choiceProbabilities-        <*> required "confidence" "How concentrated the probabilities are" choiceConfidence+        <$> required "chosen" "The most likely option" (.chosen)+        <*> required "probabilities" "Each option's probability" (.probabilities)+        <*> required "confidence" "How concentrated the probabilities are" (.confidence)  instance Contract a => Contract (Score a) where   contract =     record "A position on ordered levels" $       Score-        <$> required "position" "The probability-weighted position, from 0 upwards" position-        <*> required "probabilities" "Each level's probability" scoreProbabilities-        <*> required "confidence" "How concentrated the probabilities are" scoreConfidence+        <$> required "position" "The probability-weighted position, from 0 upwards" (.position)+        <*> required "probabilities" "Each level's probability" (.probabilities)+        <*> required "confidence" "How concentrated the probabilities are" (.confidence)  -- --------------------------------------------------------------------------- -- Wire types@@ -136,8 +136,8 @@  -- | What a System One provider receives: the encoded input and the questions. data JudgeRequest = JudgeRequest-  { requestInput :: Value-  , requestQuestions :: [QuestionSpec]+  { input :: Value+  , questions :: [QuestionSpec]   }   deriving (Eq, Ord, Show) @@ -154,7 +154,7 @@   }  instance Functor Questions where-  fmap f q = q {decoder = fmap f . decoder q}+  fmap f q = q {decoder = fmap f . q.decoder}  instance Applicative Questions where   pure x = Questions [] (\case [] -> Right x; _ -> Left "too many answers")@@ -163,7 +163,7 @@      in dl before <*> dr after  decodeAnswers :: Questions a -> [Answer] -> Either Text a-decodeAnswers = decoder+decodeAnswers = (.decoder)  single :: QuestionSpec -> (Answer -> Either Text a) -> Questions a single spec decode = Questions [spec] $ \case@@ -183,7 +183,7 @@     Choice <$> byLabel opts picked <*> traverse (\(l, p) -> (,p) <$> byLabel opts l) ps <*> pure conf   other -> Left ("expected a choice answer, got " <> T.pack (show other))   where-    opts = optionList (options @a)+    opts = (options @a).options  -- | Place the input on an 'Options' type's levels, lowest first. score :: forall a. Options a => Text -> Questions (Score a)@@ -192,13 +192,13 @@     Score pos <$> traverse (\(i, p) -> (,p) <$> byIndex i) ps <*> pure conf   other -> Left ("expected a score answer, got " <> T.pack (show other))   where-    opts = optionList (options @a)+    opts = (options @a).options     byIndex i = case drop i opts of-      o : _ | i >= 0 -> Right (optionValue o)+      o : _ | i >= 0 -> Right o.value       _ -> Left ("no level " <> T.pack (show i))  labels :: [Option a] -> [(Text, Maybe Text)]-labels = map (\o -> (optionLabel o, optionDoc o))+labels = map (\o -> (o.label, o.doc))  byLabel :: [Option a] -> Text -> Either Text a-byLabel opts l = maybe (Left ("unknown option " <> l)) (Right . optionValue) (find ((== l) . optionLabel) opts)+byLabel opts l = maybe (Left ("unknown option " <> l)) (Right . (.value)) (find ((== l) . (.label)) opts)

@@ -2,6 +2,8 @@ module Agentic.Runtime   ( -- * Runtime     Runtime (..)+  , inParallel+  , failWith   , runtime   , runtimeWith   , SystemOne (..)@@ -55,9 +57,9 @@   deriving (Eq, Show)  data ToolSpec = ToolSpec-  { specName :: Text-  , specDescription :: Text-  , specInput :: Schema+  { name :: Text+  , description :: Text+  , input :: Schema   }   deriving (Eq, Show) @@ -89,8 +91,8 @@  data ToolCall = ToolCall   { callId :: Text-  , callName :: Text-  , callInput :: Value+  , name :: Text+  , input :: Value   }   deriving (Eq, Show) @@ -98,7 +100,7 @@ -- Events and errors  data Event = Event-  { eventPath :: [Note]+  { path :: [Note]   , happened :: Happened   }   deriving (Show)@@ -127,10 +129,10 @@ -- Runtime  -- | Fast, typed judgements (Jev, or an LLM standing in).-newtype SystemOne m = SystemOne {askSystemOne :: JudgeRequest -> m [Answer]}+newtype SystemOne m = SystemOne {ask :: JudgeRequest -> m [Answer]}  -- | One LLM turn.-newtype SystemTwo m = SystemTwo {askSystemTwo :: Conversation -> m Turn}+newtype SystemTwo m = SystemTwo {ask :: Conversation -> m Turn}  -- | Everything a flow needs from the outside world: its two kinds of model, -- how to run independent work, where events go, and how to raise errors.@@ -143,6 +145,15 @@   , failure :: forall a. FlowError -> m a   } +-- | Run work with a runtime's @parallel@. (Record dot can't select a+-- polymorphic field, so this and 'failWith' are functions.)+inParallel :: Runtime m -> [m a] -> m [a]+inParallel Runtime {parallel = p} = p++-- | Fail with a runtime's @failure@.+failWith :: Runtime m -> FlowError -> m a+failWith Runtime {failure = f} = f+ -- | A runtime in IO with no providers: it runs things one after another, -- observes nothing, and throws 'FlowError's. runtime :: Runtime IO@@ -176,12 +187,12 @@  -- | Also send every event to @f@. observing :: Applicative m => (Event -> m ()) -> Runtime m -> Runtime m-observing f rt = rt {observe = \e -> observe rt e *> f e}+observing f rt = rt {observe = \e -> rt.observe e *> f e}  -- | Fail a step that takes more than @n@ turns. capped :: Int -> Runtime m -> Runtime m capped n rt = rt {systemTwo = SystemTwo turn}   where     turn c-      | length (history c) >= n = failure rt (TurnLimit n)-      | otherwise = askSystemTwo (systemTwo rt) c+      | length c.history >= n = failWith rt (TurnLimit n)+      | otherwise = rt.systemTwo.ask c

@@ -41,16 +41,16 @@   deriving (Eq, Show)  data Field = Field-  { fieldName :: Text-  , fieldSchema :: Schema-  , fieldRequired :: Bool+  { name :: Text+  , schema :: Schema+  , required :: Bool   }   deriving (Eq, Show)  data Variant = Variant-  { variantTag :: Text-  , variantDoc :: Maybe Text-  , variantFields :: [Field]+  { tag :: Text+  , doc :: Maybe Text+  , fields :: [Field]   }   deriving (Eq, Show) @@ -61,20 +61,20 @@ schemaOf = Schema Nothing Nothing []  documentedSchema :: Text -> Schema -> Schema-documentedSchema d s = s {doc = Just d}+documentedSchema d (Schema t _ cs sh) = Schema t (Just d) cs sh  -- | Name the schema's type, unless it already has a name. titled :: Text -> Schema -> Schema-titled t s = s {title = maybe (Just t) Just (title s)}+titled t s = s {title = maybe (Just t) Just s.title}  -- | A short label for display, e.g. in 'Agentic.Describe.describe'. typeLabel :: Schema -> Text-typeLabel s = maybe (structural (shape s)) id (title s)+typeLabel s = maybe (structural s.shape) id s.title   where     structural = \case       SObject _ -> "object"       SSum [] -> "sum"-      SSum vs -> "sum of " <> joinTags (map variantTag vs)+      SSum vs -> "sum of " <> joinTags (map (.tag) vs)       SEnum ls -> "one of " <> joinTags (map fst ls)       SArray inner -> "[" <> typeLabel inner <> "]"       SNullable inner -> typeLabel inner <> "?"

@@ -33,14 +33,14 @@  -- | A final answer, encoded with its contract. respond :: Contract a => a -> Action-respond = Respond . encode contract+respond = Respond . contract.encode  callTools :: [(Text, Value)] -> Action callTools calls = CallTools [ToolCall ("call-" <> name) name input | (name, input) <- calls]  -- | Answer every question with a pure function of it. answering :: Applicative m => (QuestionSpec -> Answer) -> SystemOne m-answering f = SystemOne (pure . map f . requestQuestions)+answering f = SystemOne (pure . map f . (.questions))  -- | Yes/no questions get probability @p@; choices and scores pick the first -- option with certainty.

@@ -17,19 +17,19 @@ -- probability for each answer; unlike Jev's, they aren't calibrated. viaLLM :: MonadFail m => SystemTwo m -> SystemOne m viaLLM two = SystemOne $ \request -> do-  let qs = zip ids (requestQuestions request)+  let qs = zip ids request.questions       conversation =         Conversation           { path = []           , instruction = Instruction "Answer each question about the input. Give every probability as a number from 0 to 1."-          , input = requestInput request+          , input = request.input           , inputSchema = schemaOf SNull           , tools = []           , outputSchema = schemaOf (SObject [Field qid (questionSchema q) True | (qid, q) <- qs])           , history = []           }-  turn <- askSystemTwo two conversation-  case action turn of+  turn <- two.ask conversation+  case turn.action of     Respond (Object kvs) -> either (fail . T.unpack) pure (traverse (\(qid, q) -> answer q =<< field' qid kvs) qs)     Respond other -> fail ("viaLLM: expected an object of answers, got " <> T.unpack (renderJson other))     CallTools _ -> fail "viaLLM: the model called a tool while answering questions"

@@ -61,20 +61,20 @@   Pure f <*> Pure g = Pure (\w -> let (h, w1) = f w; (a, w2) = g w1 in (h a, w2))  instance Monad Pure where-  Pure g >>= k = Pure (\w -> let (a, w1) = g w in runPure (k a) w1)+  Pure g >>= k = Pure (\w -> let (a, w1) = g w in (k a).runPure w1)  say :: Text -> Pure ()-say t = Pure (\w -> ((), w {logged = logged w <> [t]}))+say t = Pure (\w -> ((), w {logged = w.logged <> [t]}))  -- | The handlers: scripted turns, fixed judgements, and every event recorded. handlers :: Runtime Pure handlers =   (runtimeWith (\e -> error ("flow error: " <> show e)))-    { systemTwo = SystemTwo $ \_ -> Pure $ \w -> case script w of+    { systemTwo = SystemTwo $ \_ -> Pure $ \w -> case w.script of         a : rest -> (Turn (Raw Null) a, w {script = rest})         [] -> error "the script ran out of turns"-    , systemOne = SystemOne $ \request -> pure (map answer (requestQuestions request))-    , observe = \e -> Pure (\w -> ((), w {events = events w <> [happened e]}))+    , systemOne = SystemOne $ \request -> pure (map answer request.questions)+    , observe = \e -> Pure (\w -> ((), w {events = w.events <> [e.happened]}))     }   where     answer = \case@@ -114,43 +114,43 @@         if ok then pure () else modifyIORef failures (+ 1)    -- 1. Explicit codecs for a record and a payload-bearing sum.-  check "a record round-trips through its codec" (decode contract (encode contract joke) == Right joke)-  check "a sum with payloads round-trips" (decode contract (encode contract (Rect 2 3)) == Right (Rect 2 3))-  check "a sum encodes its constructor as a tag" (encode contract (Circle 1) == Object [("tag", String "Circle"), ("radius", Number 1)])-  check "a record missing a field is rejected" (either (const True) (const False) (decode (contract @Joke) (Object [("setup", String "x")])))+  check "a record round-trips through its codec" (contract.decode (contract.encode joke) == Right joke)+  check "a sum with payloads round-trips" (contract.decode (contract.encode (Rect 2 3)) == Right (Rect 2 3))+  check "a sum encodes its constructor as a tag" (contract.encode (Circle 1) == Object [("tag", String "Circle"), ("radius", Number 1)])+  check "a record missing a field is rejected" (either (const True) (const False) ((contract @Joke).decode (Object [("setup", String "x")])))    let world0 =         World           { script =               [ CallTools [ToolCall "c1" "count_letters" (String "scarecrow")]               , CallTools [ToolCall "c2" "write_joke" (String "farms")]-              , Respond (encode contract joke) -- answers the nested write_joke draft+              , Respond (contract.encode joke) -- answers the nested write_joke draft               , Respond (Object [("setup", String "only a setup")]) -- invalid: no punchline-              , Respond (encode contract joke) -- the correction-              , Respond (encode contract (Rect 2 3)) -- the shape+              , Respond (contract.encode joke) -- the correction+              , Respond (contract.encode (Rect 2 3)) -- the shape               ]           , logged = []           , events = []           }       ((result, verdict), world) =-        runPure ((,) <$> interpret handlers jokeAndFigure "scarecrows" <*> interpret handlers review joke) world0-      seen = events world+        ((,) <$> interpret handlers jokeAndFigure "scarecrows" <*> interpret handlers review joke).runPure world0+      seen = world.events    -- 2. A scripted tool call runs its typed body, and the draft continues.-  check "the tool's typed body ran with the model's input" (logged world == ["count_letters ran on scarecrow"])+  check "the tool's typed body ran with the model's input" (world.logged == ["count_letters ran on scarecrow"])   check "the tool's typed result went back to the model" (any (\case ToolReturned "c1" (ToolOk (Integer 9)) -> True; _ -> False) seen)   check "the draft continued to a typed response" (result == (joke, Rect 2 3))    -- 3. A nested drafting tool.   check "the nested tool ran its own draft" (length [() | Drafting _ <- seen] == 3)-  check "the nested draft's result went back as the tool's result" (any (\case ToolReturned "c2" (ToolOk v) -> decode contract v == Right joke; _ -> False) seen)+  check "the nested draft's result went back as the tool's result" (any (\case ToolReturned "c2" (ToolOk v) -> contract.decode v == Right joke; _ -> False) seen)    -- 4. Invalid output, then a corrected response.   check "the invalid output was rejected" (length [() | OutputRejected _ <- seen] == 1)-  check "every scripted turn was used" (null (script world))+  check "every scripted turn was used" (null world.script)    -- 5. An applicative judgement batch: two questions, one request.-  check "two questions went in one request" ([length (requestQuestions r) | Judged r _ <- seen] == [2])+  check "two questions went in one request" ([length r.questions | Judged r _ <- seen] == [2])   check "the answers decoded to typed values" (verdict == (YesNo 0.9, YesNo 0.9))    -- 6. Describing the flow invokes no handlers: describe has no runtime to call.

@@ -17,9 +17,9 @@   deriving (Generic, Show, Eq, Contract)  data BetterJoke-  = DadJoke {setup' :: Text, punchline' :: Text}+  = DadJoke {setup :: Text, punchline :: Text}   | OneLiner {line :: Text}-  | KnockKnock {whosThere :: Text, punchline' :: Text}+  | KnockKnock {whosThere :: Text, punchline :: Text}   deriving (Generic, Show, Eq, Contract)  data Groan = Mild | Solid | Unbearable@@ -42,16 +42,16 @@ instance Contract Rating where   contract = mapCodec Rating (\(Rating n) -> n) (between 1 10 contract) -data Review = Review {funnyAnswer :: YesNo, groanAnswer :: Score Groan}+data Review = Review {funny :: YesNo, groan :: Score Groan}   deriving (Show, Eq)  documentedJoke :: Codec Joke documentedJoke =   record "A joke, split into its parts" $     Joke-      <$> required "genre" "The style of joke" genre-      <*> required "setup" "The setup line" setup-      <*> required "punchline" "The line that lands it" punchline+      <$> required "genre" "The style of joke" (.genre)+      <*> required "setup" "The setup line" (.setup)+      <*> required "punchline" "The line that lands it" (.punchline)  funny :: Questions YesNo funny = yesNo "Would a 10-year-old laugh at this joke?"@@ -72,7 +72,7 @@   pure runtime {systemOne = fixedAnswers p, systemTwo = two}  roundTrips :: (Eq a, Show a) => Codec a -> a -> Expectation-roundTrips c a = decode c (encode c a) `shouldBe` Right a+roundTrips c a = c.decode (c.encode a) `shouldBe` Right a  main :: IO () main = hspec $ do@@ -82,33 +82,33 @@      it "round-trips a derived sum as tagged objects" $ do       roundTrips contract (OneLiner "I'm on a seafood diet.")-      encode contract (OneLiner "x")+      contract.encode (OneLiner "x")         `shouldBe` Object [("tag", String "OneLiner"), ("line", String "x")]      it "encodes an Options type as its labels" $ do-      encode contract Solid `shouldBe` String "Solid"-      decode contract (String "Unbearable") `shouldBe` Right Unbearable+      contract.encode Solid `shouldBe` String "Solid"+      contract.decode (String "Unbearable") `shouldBe` Right Unbearable      it "names derived schemas after their type" $-      title (codecSchema (contract @Joke)) `shouldBe` Just "Joke"+      (contract @Joke).schema.title `shouldBe` Just "Joke"      it "keeps descriptions written in the codec" $-      case shape (codecSchema documentedJoke) of-        SObject fs -> map (doc . fieldSchema) fs `shouldBe` map Just ["The style of joke", "The setup line", "The line that lands it"]+      case documentedJoke.schema.shape of+        SObject fs -> map ((.doc) . (.schema)) fs `shouldBe` map Just ["The style of joke", "The setup line", "The line that lands it"]         other -> expectationFailure (show other)      it "adds descriptions to a derived contract" $-      case shape (codecSchema (field "punchline" "No explanation" (contract @Joke))) of-        SObject fs -> map (doc . fieldSchema) fs `shouldBe` [Nothing, Nothing, Just "No explanation"]+      case (field "punchline" "No explanation" (contract @Joke)).schema.shape of+        SObject fs -> map ((.doc) . (.schema)) fs `shouldBe` [Nothing, Nothing, Just "No explanation"]         other -> expectationFailure (show other)      it "checks constraints the schema can't express" $ do-      decode (contract @Rating) (Integer 7) `shouldBe` Right (Rating 7)-      decode (contract @Rating) (Integer 11) `shouldBe` Left "must be between 1 and 10"+      (contract @Rating).decode (Integer 7) `shouldBe` Right (Rating 7)+      (contract @Rating).decode (Integer 11) `shouldBe` Left "must be between 1 and 10"    describe' "Questions" $ do     it "batches combined questions into one request" $-      map (\case AskYesNo _ -> "yesNo"; AskScore _ ls -> "score " <> T.pack (show (length ls)); AskChoice _ _ -> "choice" :: Text) (specs (Review <$> funny <*> groan))+      map (\case AskYesNo _ -> "yesNo"; AskScore _ ls -> "score " <> T.pack (show (length ls)); AskChoice _ _ -> "choice" :: Text) ((Review <$> funny <*> groan).specs)         `shouldBe` ["yesNo", "score 3"]      it "decodes answers back to typed values" $@@ -134,7 +134,7 @@     it "tells the model about unknown tools instead of failing" $ do       events <- newIORef []       rt <- testRuntime [callTools [("nope", Null)], respond joke] 1-      let rt' = observing (\e -> modifyIORef events (happened e :)) rt+      let rt' = observing (\e -> modifyIORef events (e.happened :)) rt       _ <- interpret rt' (draft @Joke "a joke please") ()       results <- readIORef events       [r | ToolReturned _ r <- results] `shouldBe` [ToolFailed "there is no tool named nope"]@@ -185,7 +185,7 @@      it "never hides a branch, even when it's only glue" $ do       let flow :: Agentic IO (Joke, Joke) (Rating, Text)-          flow = draft @Rating "rate it" *** arr genre+          flow = draft @Rating "rate it" *** arr (.genre)       T.lines (renderTree (Agentic.describe flow))         `shouldBe` ["both halves", "├─ first → draft @Rating  \"rate it\"", "└─ second → arr"] @@ -219,7 +219,7 @@      it "shows a loop and what it runs" $ do       let flow :: Agentic IO Joke Joke-          flow = repeatUntil ((== "kids") . genre) (draft @Joke "make it more kid-friendly") `named` "polish until it's for kids"+          flow = repeatUntil ((== "kids") . (.genre)) (draft @Joke "make it more kid-friendly") `named` "polish until it's for kids"       T.lines (renderTree (Agentic.describe flow))         `shouldBe` ["polish until it's for kids  repeatUntil", "└─ draft @Joke  \"make it more kid-friendly\""] @@ -240,7 +240,7 @@      it "sends a loop's again edge back to the body's first step, in both formats" $ do       let flow :: Agentic IO Joke Joke-          flow = repeatUntil ((== "kids") . genre) (draft @Joke "make it kid-friendly" >>> act pure `named` "show it")+          flow = repeatUntil ((== "kids") . (.genre)) (draft @Joke "make it kid-friendly" >>> act pure `named` "show it")           d = Agentic.describe flow       filter (T.isInfixOf "again") (T.lines (mermaid d)) `shouldBe` ["  n2 -.->|again| n1"]       filter (T.isInfixOf "again") (T.lines (dot d)) `shouldBe` ["  n2 -> n1 [label=\"again\", style=dashed];"]