agentic 0.2.0.4 → 0.2.0.5

raw patch · 8 files changed

+184/−25 lines, 8 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +17/−0
• README.md +11/−3
• agentic.cabal +1/−1
• src/Agentic/Core.hs +33/−0
• src/Agentic/Describe.hs +85/−17
• src/Agentic/Interpret.hs +2/−0
• test/Portable.hs +11/−4
• test/Spec.hs +24/−0

@@ -1,5 +1,22 @@ # Changelog for agentic +## 0.2.0.5 - 2026-10-06++* `takeFirst` and `takeSecond` do what `arr fst` and `arr snd` do, but a+  diagram can follow them. `StepInfo` has `FirstHalf` and `SecondHalf` for+  them.+* `:/\` is a pair, as a type and a pattern, so the nested pairs `&&&` builds+  read flat: `\(creature :/\ picture :/\ card) -> ...`.+* `mermaid` and `dot` follow each half of a pair from `&&&` or `***`, so a+  later `first`, `second` or `***` is wired only to the half it gets.+  Previously every step before the pair was wired into both halves.+* A step reached by the same node along several routes, such as both sides of+  a `|||`, gets one edge instead of one per route.+* A `repeatUntil`'s input is drawn going straight out as well as through the+  body, since the condition is checked before the first run.+* `(a &&& b) &&& c` is described as a pair inside a pair, not flattened like+  `a &&& b &&& c`.+ ## 0.2.0.4 - 2026-10-06  * Record fields are no longer functions: the packages are written with

@@ -260,7 +260,7 @@   draft @[Creature] "Name 10 prehistoric creatures a grade 5 class might have heard of. Include a mix of kinds, not only dinosaurs."     >>> each classify     >>> arr (partition (clearly Dinosaur 0.8)) `named` "split off the clear dinosaurs (≥ 0.8)"-    >>> (each (arr fst >>> exhibit) *** arr (map notADinosaur) `named` "note what the others were")+    >>> (each (takeFirst >>> exhibit) *** arr (map notADinosaur) `named` "note what the others were")     >>> arr (uncurry Exhibit)     >>> draft @Poster "Create a poster of these dinosaurs for a grade 5 class. Add a corner about the creatures that weren't dinosaurs, and what they were." @@ -273,9 +273,12 @@   (returnA &&& draft @DinoPic "Draw an ascii picture of this dinosaur, 10 lines high"            &&& draft @TrumpCard "Make a trump card for this dinosaur")     `named` "exhibit"-    >>> arr (\(c, (p, t)) -> Entry c p t)+    >>> arr (\(dinosaur :/\ picture :/\ card) -> Entry dinosaur picture card) ``` +`a &&& b &&& c` builds the nested pair `(a, (b, c))`, and `:/\` matches it+without the brackets: `dinosaur :/\ picture :/\ card`. It works as a type too.+ The trump card's stats use a `Stat` contract that checks 1 to 10, so every card uses the same scale. And the poster is drafted from a named `Exhibit` record rather than a tuple, so Claude sees `dinosaurs` and `notDinosaurs` instead of@@ -352,7 +355,7 @@   n3 -->|first| n6   n3 -->|first| n7   n3 -->|second| n8-  n3 -->|first| n9+  n3 --> n9   n6 --> n9   n7 --> n9   n8 --> n9@@ -362,6 +365,11 @@ `describe` returns a plain `Description` you can walk yourself, and `descriptionValue` turns it into JSON for UIs and other agents. The tree hides unnamed glue between steps, but never a branch.++The diagram follows each half of a pair from `&&&` or `***` to wherever it+goes next, but it can't see inside an `arr`, so `arr fst` loses track of which+step the half came from. `takeFirst` and `takeSecond` do the same job and keep+it.  ### Naming things 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               agentic-version:            0.2.0.4+version:            0.2.0.5 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.

@@ -1,4 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PatternSynonyms #-}  -- | Flows: typed, inspectable descriptions of agentic work. module Agentic.Core@@ -22,6 +23,11 @@   , repeatUntil   , note   , named+    -- * Plumbing+  , takeFirst+  , takeSecond+  , (:/\)+  , pattern (:/\)     -- * Judgement helpers   , keep   , gate@@ -63,6 +69,10 @@     -- ^ The input re-wrapped without changing it ('Left', 'Right'), so that     -- 'Agentic.Describe.describe' can show it as a pass-through.   Arr :: (i -> o) -> Step m i o+  TakeFirst :: Step m (a, b) a+    -- ^ 'takeFirst': unlike @arr fst@, 'Agentic.Describe.describe' can see+    -- which half it keeps.+  TakeSecond :: Step m (a, b) b   Act :: (i -> m o) -> Step m i o   Draft :: Codec i -> Codec o -> Instruction -> [Tool m] -> Step m i o   Judge :: Codec i -> Questions o -> Step m i o@@ -110,6 +120,29 @@   right f = Choose (Step (Wrap Left)) (f >>> Step (Wrap Right))   f +++ g = Choose (f >>> Step (Wrap Left)) (g >>> Step (Wrap Right))   f ||| g = Choose f g++-- | The first half of a pair. It does what @arr fst@ does, but a diagram can+-- follow it: after @&&&@ or @***@, it knows which step the half came from.+takeFirst :: Agentic m (a, b) a+takeFirst = Step TakeFirst++-- | The second half of a pair, like 'takeFirst'.+takeSecond :: Agentic m (a, b) b+takeSecond = Step TakeSecond++infixr 6 :/\++-- | A pair, written so that the nested pairs @&&&@ and @***@ build read flat:+-- @a &&& b &&& c@ gives an @A :\/\\ B :\/\\ C@, which is @(A, (B, C))@.+type a :/\ b = (a, b)++-- | Build or match a pair the same way:+--+-- > arr (\(creature :/\ picture :/\ card) -> Entry creature picture card)+pattern (:/\) :: a -> b -> (a, b)+pattern a :/\ b = (a, b)++{-# COMPLETE (:/\) #-}  -- | An LLM writes an @o@ from the step's input. --

@@ -44,6 +44,10 @@     -- ^ The input, unchanged ('returnA').   | Glue     -- ^ @arr@: a pure function.+  | FirstHalf+    -- ^ 'takeFirst'.+  | SecondHalf+    -- ^ 'takeSecond'.   | Effect     -- ^ @act@: plain code with an effect.   | DraftInfo@@ -70,7 +74,9 @@ describe = \case   Step s -> Leaf (stepInfo s)   Seq f g -> Sequence (sequenced (describe f) <> sequenced (describe g))-  Fanout f g -> Together (together (describe f) <> together (describe g))+  -- Only the right is flattened: @(a &&& b) &&& c@ is a different shape of+  -- pair from @a &&& b &&& c@, and the graph routes by that shape.+  Fanout f g -> Together (describe f : together (describe g))   Split f g -> Halves (describe f) (describe g)   First f -> Halves (describe f) (Leaf Identity)   Choose f g -> Branch (describe f) (describe g)@@ -90,6 +96,8 @@   Pass -> Identity   Wrap _ -> Identity   Arr _ -> Glue+  TakeFirst -> FirstHalf+  TakeSecond -> SecondHalf   Act _ -> Effect   Draft input out instruction tools ->     DraftInfo instruction input.schema out.schema (map toolInfo tools)@@ -119,6 +127,8 @@ trees seen = \case   Leaf Identity -> (seen, [])   Leaf Glue -> (seen, [])+  Leaf FirstHalf -> (seen, [])+  Leaf SecondHalf -> (seen, [])   Leaf info -> leaf Nothing info   Sequence ds -> onSnd concat (mapAccumL trees seen ds)   Together ds ->@@ -159,7 +169,7 @@       r -> r     -- A branch always shows, even when it's only glue.     branch s d = case trees s d of-      (s', []) -> (s', [Node (if passes d then "pass" else "arr") []])+      (s', []) -> (s', [Node (plumbing d) []])       r -> r     toolTree s t       | t.name `elem` s = (s, Node ("tool " <> t.name <> "  (see above)") [])@@ -171,6 +181,15 @@       [] -> Node (l <> " → pass") []       ts -> Node l ts +-- | How a branch that's only plumbing shows in the tree view.+plumbing :: Description -> Text+plumbing = \case+  d | passes d -> "pass"+  Leaf FirstHalf -> "takeFirst"+  Leaf SecondHalf -> "takeSecond"+  Annotated _ d -> plumbing d+  _ -> "arr"+ -- | Does this part of a flow only pass its input through? passes :: Description -> Bool passes = \case@@ -235,7 +254,7 @@   where     flow = do       item (ItemNode "input" Terminal ["input"])-      exits <- build InSequence [("input", Nothing)] d+      exits <- build InSequence (Sources [("input", Nothing)]) d       item (ItemNode "output" Terminal ["output"])       connect exits "output" @@ -243,9 +262,31 @@ -- branch that's only glue is still a branch. data Context = InSequence | InBranch --- | Nodes the next step connects from, each with an optional edge label.-type From = [(Text, Maybe Text)]+-- | Where the next step's input comes from: nodes, each with an optional edge+-- label, or a pair (after @&&&@ or @***@) whose halves are known separately, so+-- a later @first@, @second@ or @***@ wires each half to its own flow.+data From = Sources [(Text, Maybe Text)] | Pair From From +-- | Every node a 'From' draws on, once each. A node reached by routes with+-- different labels (both sides of a @|||@) keeps one unlabelled edge.+sources :: From -> [(Text, Maybe Text)]+sources = dedupe . go+  where+    go = \case+      Sources s -> s+      Pair a b -> go a <> go b+    dedupe = \case+      [] -> []+      (n, l) : rest ->+        let others = [l' | (n', l') <- rest, n' == n]+         in (n, if all (== l) others then l else Nothing) : dedupe [x | x@(n', _) <- rest, n' /= n]++-- | The two sides of a @|||@ joining again: where both made a pair, so does+-- the join.+merge :: From -> From -> From+merge (Pair a b) (Pair c d) = Pair (merge a c) (merge b d)+merge x y = Sources (sources (Pair x y))+ -- | A counter for ids, the items of each open box (innermost first), and edges. data BuildState = BuildState Int [[Item]] [Edge] @@ -284,14 +325,14 @@     nubOrdered = foldr (\x acc -> x : filter (/= x) acc) []  connect :: From -> Text -> Build ()-connect from to = mapM_ (\(f, l) -> edge (Edge f to l Flow)) from+connect from to = mapM_ (\(f, l) -> edge (Edge f to l Flow)) (sources from)  node :: From -> [Text] -> Build From node from label = do   n <- fresh   item (ItemNode n StepNode label)   connect from n-  pure [(n, Nothing)]+  pure (Sources [(n, Nothing)])  box :: [Text] -> Build a -> Build (Text, a) box label inside = do@@ -306,28 +347,51 @@ build :: Context -> From -> Description -> Build From build context from = \case   Leaf Identity -> pure from+  -- A known pair's half goes on exactly; otherwise it's like any @arr@.+  Leaf FirstHalf | Pair a _ <- from -> pure a+  Leaf SecondHalf | Pair _ b <- from -> pure b+  Leaf FirstHalf -> half "takeFirst"+  Leaf SecondHalf -> half "takeSecond"   Leaf Glue -> case context of-    InSequence -> pure from+    -- An @arr@ can take a pair apart any way it likes, so its halves are lost,+    -- and so is what the edge labels inside it said.+    InSequence -> pure $ case from of+      Pair _ _ -> Sources [(n, Nothing) | (n, _) <- sources from]+      Sources _ -> from     InBranch -> node from ["arr"]   Leaf info -> step Nothing info   Sequence ds -> chain from ds-  Together ds -> concat <$> mapM (build InBranch from) ds-  Halves l r -> (<>) <$> build InBranch (labelled "first") l <*> build InBranch (labelled "second") r-  Branch l r -> (<>) <$> build InBranch (labelled "left") l <*> build InBranch (labelled "right") r-  ForEach f -> snd <$> box ["each"] (build InSequence from f)+  Together ds -> pairUp <$> mapM (build InBranch from) ds+  -- A pair whose halves are known sends each to its flow. Otherwise every+  -- source might hold either half, so the edges say which half they carry.+  Halves l r -> case from of+    Pair a b -> Pair <$> build InBranch a l <*> build InBranch b r+    _ -> Pair <$> build InBranch (labelled "first") l <*> build InBranch (labelled "second") r+  Branch l r -> merge <$> build InBranch (labelled "left") l <*> build InBranch (labelled "right") r+  ForEach f -> Sources . sources . snd <$> box ["each"] (build InSequence (Sources (sources from)) f)   -- "Again" goes back to where the body starts: the steps the loop's input   -- flows into. If the body has none, it goes to the box.   Repeated f -> do     before <- edgeCount     (b, exits) <- box ["repeatUntil"] (build InSequence from f)-    entries <- entriesSince before (map fst from)+    entries <- entriesSince before (map fst (sources from))     let targets = if null entries then [b] else entries-    mapM_ (\(e, _) -> mapM_ (\t -> edge (Edge e t (Just "again") Again)) targets) exits-    pure exits+    mapM_ (\(e, _) -> mapM_ (\t -> edge (Edge e t (Just "again") Again)) targets) (sources exits)+    -- The condition is checked before the first run, so the input can leave+    -- without going through the body.+    pure (merge from exits)   Annotated n (Leaf info) | not (passes (Leaf info)) -> step (Just n) info   Annotated n f -> snd <$> box (n.name : maybe [] pure n.description) (build InSequence from f)   where-    labelled l = [(f, Just l) | (f, _) <- from]+    labelled l = Sources [(f, Just l) | (f, _) <- sources from]+    -- A half of a pair the graph can't follow: plumbing, like @arr@.+    half name = case context of+      InSequence -> pure from+      InBranch -> node from [name]+    pairUp = \case+      [] -> from+      [x] -> x+      x : xs -> Pair x (pairUp xs)     chain acc = \case       [] -> pure acc       x : xs -> build InSequence acc x >>= (`chain` xs)@@ -344,7 +408,7 @@             ( \t -> do                 n <- fresh                 item (ItemNode n ToolNode ["tool " <> t.name])-                mapM_ (\(e, _) -> edge (Edge e n Nothing Uses)) exits+                mapM_ (\(e, _) -> edge (Edge e n Nothing Uses)) (sources exits)             )             tools         _ -> pure ()@@ -358,6 +422,8 @@     (kind, details) = case info of       Identity -> ("pass", [])       Glue -> ("arr", [])+      FirstHalf -> ("takeFirst", [])+      SecondHalf -> ("takeSecond", [])       Effect -> ("act", [])       DraftInfo instruction _ out _ -> ("draft @" <> typeLabel out, [quoted instruction.text])       JudgeInfo _ [q] -> ("judge", [questionText q])@@ -469,6 +535,8 @@     leaf = \case       Identity -> node "pass" []       Glue -> node "arr" []+      FirstHalf -> node "takeFirst" []+      SecondHalf -> node "takeSecond" []       Effect -> node "act" []       DraftInfo instruction input out tools ->         node

@@ -43,6 +43,8 @@     step path s x = case s of       Pass -> pure x       Wrap f -> pure (f x)+      TakeFirst -> pure (fst x)+      TakeSecond -> pure (snd x)       Arr f -> pure (f x)       Act f -> emit path Acted >> f x       Judge input qs

@@ -19,15 +19,15 @@ -- --------------------------------------------------------------------------- -- Explicit codecs: a record, and a sum with payloads -data Joke = Joke Text Text+data Joke = Joke {setup :: Text, punchline :: Text}   deriving (Show, Eq)  instance Contract Joke where   contract =     record "A joke" $       Joke-        <$> required "setup" "The setup line" (\(Joke s _) -> s)-        <*> required "punchline" "The line that lands it" (\(Joke _ p) -> p)+        <$> required "setup" "The setup line" (.setup)+        <*> required "punchline" "The line that lands it" (.punchline)  data Figure = Circle Double | Rect Double Double   deriving (Show, Eq)@@ -157,6 +157,13 @@   let tree = renderTree (describe jokeAndFigure)   check "describe shows the drafts and both tools" (all (`T.isInfixOf` tree) ["draft @Joke", "tool count_letters  act", "tool write_joke  draft @Joke", "draft @Figure"]) -  -- 7. All of the above ran in Pure, not IO.+  -- 7. Plumbing a diagram can follow runs like arr fst and arr snd.+  let halves = (,) <$> interpret handlers (arr (\x -> (x, x + 1)) >>> takeFirst) (1 :: Int) <*> interpret handlers (arr (\x -> (x, x + 1)) >>> takeSecond) (1 :: Int)+  check "takeFirst and takeSecond keep their halves" (fst (halves.runPure world0) == (1, 2))+  let flat :: Int :/\ Text :/\ Bool+      flat = 1 :/\ "two" :/\ True+  check "a :/\\ pair builds and matches nested pairs" (flat == (1, ("two", True)) && (case flat of _ :/\ t :/\ _ -> t == "two"))++  -- 8. All of the above ran in Pure, not IO.   n <- readIORef failures   if n == 0 then putStrLn "all checks passed" else putStrLn (show n <> " checks failed") >> exitFailure

@@ -229,6 +229,30 @@           edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))       edges `shouldBe` ["  input --> n0", "  input --> output", "  n0 --> output"] +    it "wires second to the second half of a known pair" $ do+      let flow :: Agentic IO Joke (Joke, Rating)+          flow = (draft @Joke "retell it" &&& draft @Rating "rate it") >>> second (draft @Rating "rate it again")+          edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))+      edges `shouldBe` ["  input --> n0", "  input --> n1", "  n1 --> n2", "  n0 --> output", "  n2 --> output"]++    it "joins a pass-through from both sides of a choice with one edge" $ do+      let flow :: Agentic IO (Either Joke Joke) (Joke, Rating)+          flow = (returnA &&& draft @Rating "rate it") ||| (returnA &&& draft @Rating "rate it harshly")+          edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))+      edges `shouldBe` ["  input -->|left| n0", "  input -->|right| n1", "  input --> output", "  n0 --> output", "  n1 --> output"]++    it "follows takeSecond to the half it keeps" $ do+      let flow :: Agentic IO Joke Rating+          flow = (draft @Joke "retell it" &&& draft @Rating "rate it") >>> takeSecond >>> draft @Rating "rate it again"+          edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))+      edges `shouldBe` ["  input --> n0", "  input --> n1", "  n1 --> n2", "  n2 --> output"]++    it "lets a loop's input leave without going through the body" $ do+      let flow :: Agentic IO Joke Joke+          flow = repeatUntil ((== "kids") . (.genre)) (draft @Joke "make it kid-friendly") >>> act pure `named` "show it"+          edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))+      edges `shouldBe` ["  input --> n1", "  input --> n2", "  n1 --> n2", "  n2 --> output"]+     it "draws the same graph as DOT, with boxes as clusters" $ do       let flow :: Agentic IO [Joke] [Joke]           flow = each (draft @Joke "polish it") `named` "polish"