diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Changelog for agentic
+
+## 0.2.0.0 - 2026-10-01
+
+First release of the v2 design.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,25 @@
+Copyright (c) 2026, Tom Wells
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/agentic.cabal b/agentic.cabal
new file mode 100644
--- /dev/null
+++ b/agentic.cabal
@@ -0,0 +1,66 @@
+cabal-version:      3.0
+name:               agentic
+version:            0.2.0.0
+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.
+license:            BSD-2-Clause
+license-file:       LICENSE
+author:             Tom Wells
+maintainer:         drshade@gmail.com
+copyright:          2026 Tom Wells
+category:           AI
+homepage:           https://github.com/drshade/haskell-agentic
+bug-reports:        https://github.com/drshade/haskell-agentic/issues
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+tested-with:        GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2 || ==9.14.1
+
+source-repository head
+  type:     git
+  location: https://github.com/drshade/haskell-agentic.git
+  subdir:   agentic
+
+common shared
+  default-language: GHC2021
+  default-extensions:
+    DataKinds
+    DefaultSignatures
+    DeriveAnyClass
+    DerivingVia
+    GADTs
+    LambdaCase
+    OverloadedStrings
+    RankNTypes
+  ghc-options:      -Wall -Wno-name-shadowing
+
+library
+  import:           shared
+  hs-source-dirs:   src
+  exposed-modules:
+    Agentic
+    Agentic.Contract
+    Agentic.Core
+    Agentic.Describe
+    Agentic.Interpret
+    Agentic.Questions
+    Agentic.Runtime
+    Agentic.Schema
+    Agentic.Scripted
+    Agentic.Settings
+    Agentic.Value
+    Agentic.ViaLLM
+  build-depends:
+    , base  >=4.18 && <5
+    , text  >=2.0  && <2.2
+
+test-suite agentic-test
+  import:           shared
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          Spec.hs
+  build-depends:
+    , agentic          ==0.2.*
+    , base             >=4.18 && <5
+    , hspec  >=2.10 && <3
+    , text             >=2.0 && <2.2
diff --git a/src/Agentic.hs b/src/Agentic.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic.hs
@@ -0,0 +1,33 @@
+-- | Composable agentic workflows: typed steps, mixing LLMs and System One
+-- models such as Jev, that you can inspect before you run them.
+--
+-- This module is for writing and running flows. The fields of the types that
+-- providers work with (t'Conversation', t'Schema' and t'Field'), and the
+-- constructors of 'Format', aren't exported here, so they don't clash with your
+-- own types; provider code imports "Agentic.Runtime" and "Agentic.Schema"
+-- directly.
+module Agentic
+  ( module Agentic.Core
+  , module Agentic.Contract
+  , module Agentic.Questions
+  , module Agentic.Runtime
+  , module Agentic.Interpret
+  , module Agentic.Describe
+  , module Agentic.Value
+  , module Agentic.Schema
+  , module Agentic.ViaLLM
+  , module Agentic.Settings
+  ) where
+
+import Agentic.Contract
+import Agentic.Core
+import Agentic.Describe
+import Agentic.Interpret
+import Agentic.Questions
+import Agentic.Runtime hiding (Conversation (..))
+import Agentic.Runtime (Conversation)
+import Agentic.Schema hiding (Field (..), Format (..), Schema (..))
+import Agentic.Schema (Field, Format, Schema)
+import Agentic.Settings
+import Agentic.Value
+import Agentic.ViaLLM
diff --git a/src/Agentic/Contract.hs b/src/Agentic/Contract.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Contract.hs
@@ -0,0 +1,470 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+-- | Contracts: two-way codecs with documentation. A contract says how to show a
+-- value to a model, how to read one back, and what its schema looks like.
+module Agentic.Contract
+  ( -- * Codecs
+    Codec (..)
+  , Contract (..)
+  , mapCodec
+    -- * Records
+  , ObjectCodec
+  , record
+  , required
+  , requiredWith
+  , optional
+  , lmapObject
+    -- * Sums
+  , Case
+  , sumOf
+  , constructor
+    -- * Adjusting contracts
+  , documented
+  , field
+  , checked
+  , between
+    -- * Generic deriving
+  , genericContract
+  , GContract (..)
+  , GCases (..)
+  , GCase (..)
+  , GFields (..)
+    -- * Enumerations
+  , Options (..)
+  , OptionSet (..)
+  , Option (..)
+  , option
+  , described
+  , Enumeration (..)
+  , enumeration
+  , GEnum (..)
+  , GConName (..)
+  ) where
+
+import Agentic.Schema
+import Agentic.Value
+import Data.Kind (Type)
+import Data.List (find)
+import Data.Maybe (fromMaybe, isJust)
+import Data.Text (Text)
+import qualified Data.Text as T
+import GHC.Generics
+
+-- ---------------------------------------------------------------------------
+-- Codecs
+
+data Codec a = Codec
+  { codecSchema :: Schema
+  , encode :: a -> Value
+  , decode :: Value -> Either Text a
+  }
+
+class Contract a where
+  contract :: Codec a
+  default contract :: (Generic a, GContract (Rep a)) => Codec a
+  contract = genericContract
+
+mapCodec :: (a -> b) -> (b -> a) -> Codec a -> Codec b
+mapCodec to' from' c = Codec (codecSchema c) (encode c . from') (fmap to' . decode c)
+
+primitive :: Shape -> (a -> Value) -> (Value -> Either Text a) -> Codec a
+primitive s = Codec (schemaOf s)
+
+mismatch :: Text -> Value -> Either Text a
+mismatch expected v = Left ("expected " <> expected <> ", got " <> renderJson v)
+
+instance Contract Text where
+  contract = primitive (SString Nothing) String $ \case
+    String s -> Right s
+    v -> mismatch "text" v
+
+instance Contract Bool where
+  contract = primitive SBool Bool $ \case
+    Bool b -> Right b
+    v -> mismatch "a boolean" v
+
+instance Contract Integer where
+  contract = primitive SInteger Integer $ \case
+    Integer n -> Right n
+    Number d | d == fromInteger (round d) -> Right (round d)
+    v -> mismatch "an integer" v
+
+instance Contract Int where
+  contract = mapCodec fromInteger toInteger contract
+
+instance Contract Double where
+  contract = primitive SNumber Number $ \case
+    Number d -> Right d
+    Integer n -> Right (fromInteger n)
+    v -> mismatch "a number" v
+
+instance Contract () where
+  contract = primitive SNull (const Null) (const (Right ()))
+
+instance Contract a => Contract [a] where
+  contract =
+    let c = contract @a
+     in Codec
+          (schemaOf (SArray (codecSchema c)))
+          (Array . map (encode c))
+          ( \case
+              Array vs -> traverse (decode c) vs
+              v -> mismatch "a list" v
+          )
+
+instance Contract a => Contract (Maybe a) where
+  contract =
+    let c = contract @a
+     in Codec
+          (schemaOf (SNullable (codecSchema c)))
+          (maybe Null (encode c))
+          ( \case
+              Null -> Right Nothing
+              v -> Just <$> decode c v
+          )
+
+instance (Contract a, Contract b) => Contract (a, b) where
+  contract =
+    record "A pair" $
+      (,) <$> required "_1" "" fst <*> required "_2" "" snd
+
+instance (Contract a, Contract b, Contract c) => Contract (a, b, c) where
+  contract =
+    record "A triple" $
+      (,,)
+        <$> required "_1" "" (\(a, _, _) -> a)
+        <*> required "_2" "" (\(_, b, _) -> b)
+        <*> required "_3" "" (\(_, _, c) -> c)
+
+-- ---------------------------------------------------------------------------
+-- Records
+
+-- | The fields of an object: encodes an @i@, decodes an @o@. Build one
+-- applicatively with 'required', then close it with 'record'.
+data ObjectCodec i o = ObjectCodec
+  { objectFields :: [Field]
+  , objectEncode :: i -> [(Text, Value)]
+  , objectDecode :: [(Text, Value)] -> Either Text o
+  }
+
+instance Functor (ObjectCodec i) where
+  fmap f o = o {objectDecode = fmap f . objectDecode o}
+
+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)
+
+lmapObject :: (j -> i) -> ObjectCodec i o -> ObjectCodec j o
+lmapObject g o = o {objectEncode = objectEncode o . g}
+
+-- | A described field, using the field type's contract.
+required :: Contract a => Text -> Text -> (r -> a) -> ObjectCodec r a
+required name d = requiredWith name (nonEmpty d) contract
+
+-- | A field with an explicit codec. Nullable fields ('Maybe') may be absent.
+requiredWith :: Text -> Maybe Text -> Codec a -> (r -> a) -> ObjectCodec r a
+requiredWith name d c get =
+  ObjectCodec
+    [Field name schema (not nullable)]
+    (\r -> [(name, encode c (get r))])
+    ( \kvs -> case lookupField name kvs of
+        Just v -> prefix (decode c v)
+        Nothing
+          | nullable -> prefix (decode c Null)
+          | otherwise -> Left ("missing field " <> name)
+    )
+  where
+    schema = maybe id documentSchema d (codecSchema c)
+    nullable = case shape (codecSchema c) of
+      SNullable _ -> True
+      _ -> False
+    prefix = either (\e -> Left (name <> ": " <> e)) Right
+
+-- | A field that may be absent.
+optional :: Contract a => Text -> Text -> (r -> Maybe a) -> ObjectCodec r (Maybe a)
+optional = required
+
+-- | Close an object codec into a contract for a record.
+record :: Text -> ObjectCodec a a -> Codec a
+record d o =
+  Codec
+    (documentSchema' (nonEmpty d) (schemaOf (SObject (objectFields o))))
+    (Object . objectEncode o)
+    ( \case
+        Object kvs -> objectDecode o kvs
+        v -> mismatch "an object" v
+    )
+
+-- ---------------------------------------------------------------------------
+-- Sums
+
+-- | 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
+  }
+
+-- | A constructor: its tag, a description, how to recognise it, and its fields.
+--
+-- > constructor "OneLiner" "A single line" isOneLiner (OneLiner <$> required "line" "" line)
+constructor :: Text -> Text -> (a -> Bool) -> ObjectCodec a a -> Case a
+constructor tag d matches o =
+  Case
+    tag
+    (nonEmpty d)
+    (objectFields o)
+    (\a -> if matches a then Just (objectEncode o a) else Nothing)
+    (objectDecode o)
+
+-- | 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.
+sumOf :: Text -> [Case a] -> Codec a
+sumOf d = sumCodec (nonEmpty d)
+
+sumCodec :: Maybe Text -> [Case a] -> Codec a
+sumCodec d cases
+  | all (null . caseFields) cases =
+      Codec
+        (documentSchema' d (schemaOf (SEnum [(caseTag c, caseDoc c) | c <- cases])))
+        (\a -> maybe Null (String . caseTag) (matching a))
+        ( \case
+            String t | Just c <- byTag t -> caseDecode c []
+            v -> mismatch ("one of " <> T.intercalate ", " (map caseTag cases)) v
+        )
+  | otherwise =
+      Codec
+        (documentSchema' 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
+            (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)
+            v -> mismatch "an object with a tag" v
+        )
+  where
+    matching a = find (\c -> isJust (caseEncode c a)) cases
+    byTag t = find ((== t) . caseTag) cases
+
+-- ---------------------------------------------------------------------------
+-- Adjusting contracts
+
+-- | Describe the whole type.
+documented :: Text -> Codec a -> Codec a
+documented d c = c {codecSchema = documentSchema d (codecSchema c)}
+
+-- | 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)}}
+  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]
+      _ -> error ("Agentic.Contract.field: no field named " <> T.unpack name)
+    named f = fieldName f == name
+    describeField f
+      | named f = f {fieldSchema = documentSchema d (fieldSchema f)}
+      | otherwise = f
+
+-- | A constraint the wire schemas can't express. It's stated to the model and
+-- checked locally; a value that fails it goes back to the model.
+checked :: Text -> (a -> Bool) -> Codec a -> Codec a
+checked rule ok c =
+  Codec
+    ((codecSchema c) {checks = checks (codecSchema c) <> [rule]})
+    (encode c)
+    ( \v -> do
+        a <- decode c v
+        if ok a then Right a else Left ("must be " <> rule)
+    )
+
+between :: (Ord a, Show a) => a -> a -> Codec a -> Codec a
+between lo hi =
+  checked
+    ("between " <> T.pack (show lo) <> " and " <> T.pack (show hi))
+    (\a -> a >= lo && a <= hi)
+
+documentSchema' :: Maybe Text -> Schema -> Schema
+documentSchema' = maybe id documentSchema
+
+nonEmpty :: Text -> Maybe Text
+nonEmpty t = if T.null t then Nothing else Just t
+
+-- ---------------------------------------------------------------------------
+-- Generic deriving
+
+-- | A contract built from the type's 'Generic' representation, without
+-- descriptions. Records become objects, sums become tagged objects, sums of
+-- constructors without fields become enumerations, and a constructor with a
+-- single unnamed field is transparent.
+genericContract :: forall a. (Generic a, GContract (Rep a)) => Codec a
+genericContract = mapCodec to from (gcontract @(Rep a))
+
+class GContract (f :: Type -> Type) where
+  gcontract :: Codec (f p)
+
+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)
+    where
+      named c = c {codecSchema = titled (T.pack (datatypeName (undefined :: M1 D d f ()))) (codecSchema c)}
+
+recordFromCase :: Case a -> Codec a
+recordFromCase c =
+  Codec
+    (schemaOf (SObject (caseFields c)))
+    (Object . fromMaybe [] . caseEncode c)
+    ( \case
+        Object kvs -> caseDecode c kvs
+        v -> mismatch "an object" v
+    )
+
+data GCase a = GCase {gcase :: Case a, _gcaseBare :: Maybe (Codec a)}
+
+class GCases (f :: Type -> Type) where
+  gcases :: [GCase (f p)]
+
+instance GCases V1 where
+  gcases = []
+
+instance (GCases f, GCases g) => GCases (f :+: g) where
+  gcases = map (inject L1 (\case L1 x -> Just x; R1 _ -> Nothing)) (gcases @f)
+    <> 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
+
+instance (Constructor c, GFields f) => GCases (M1 C c f) where
+  gcases =
+    [ GCase
+        (Case tag Nothing (objectFields o) (Just . objectEncode o) (objectDecode o))
+        (mapCodec M1 unM1 <$> gbare @f)
+    ]
+    where
+      tag = T.pack (conName (undefined :: M1 C c f ()))
+      o = lmapObject unM1 (M1 <$> snd (gfields @f 1))
+
+class GFields (f :: Type -> Type) where
+  -- | The fields, numbering unnamed ones from the given index.
+  gfields :: Int -> (Int, ObjectCodec (f p) (f p))
+  -- | The codec of a lone unnamed field, if that's what this is.
+  gbare :: Maybe (Codec (f p))
+
+instance GFields U1 where
+  gfields n = (n, pure U1)
+  gbare = Nothing
+
+instance (GFields f, GFields g) => GFields (f :*: g) where
+  gfields n =
+    let (n1, a) = gfields @f n
+        (n2, b) = gfields @g n1
+     in (n2, (:*:) <$> lmapObject (\(x :*: _) -> x) a <*> lmapObject (\(_ :*: y) -> y) b)
+  gbare = Nothing
+
+instance (Selector s, Contract a) => GFields (M1 S s (K1 i a)) where
+  gfields n = (n + 1, M1 . K1 <$> requiredWith name Nothing contract (unK1 . unM1))
+    where
+      selector = selName (undefined :: M1 S s (K1 i a) ())
+      name = if null selector then "_" <> T.pack (show n) else T.pack selector
+  gbare
+    | null (selName (undefined :: M1 S s (K1 i a) ())) = Just (mapCodec (M1 . K1) (unK1 . unM1) contract)
+    | otherwise = Nothing
+
+-- ---------------------------------------------------------------------------
+-- Enumerations
+
+data Option a = Option
+  { optionValue :: a
+  , optionLabel :: Text
+  , optionDoc :: Maybe Text
+  }
+
+data OptionSet a = OptionSet
+  { optionsDoc :: Maybe Text
+  , optionList :: [Option a]
+    -- ^ In order. For a score, this is the level order, lowest first.
+  }
+
+-- | Types whose values are a fixed, ordered list of described options. Jev's
+-- @choice@ and @score@ need one.
+class Options a where
+  options :: OptionSet a
+  default options :: (Generic a, GEnum (Rep a), GConName (Rep a)) => OptionSet a
+  options = OptionSet Nothing [Option v (conLabel v) Nothing | v <- map to (genum @(Rep a))]
+
+-- | One option, labelled with its constructor name.
+option :: (Generic a, GConName (Rep a)) => a -> Text -> Option a
+option v d = Option v (conLabel v) (nonEmpty d)
+
+described :: Text -> [Option a] -> OptionSet a
+described d = OptionSet (nonEmpty d)
+
+conLabel :: (Generic a, GConName (Rep a)) => a -> Text
+conLabel = T.pack . gconName . from
+
+-- | Use with @deriving via@ to give an 'Options' type a matching 'Contract':
+--
+-- > deriving via Enumeration Groan instance Contract Groan
+newtype Enumeration a = Enumeration a
+
+instance (Options a, Eq a) => Contract (Enumeration a) where
+  contract = mapCodec Enumeration (\(Enumeration a) -> a) enumeration
+
+-- | The contract of an 'Options' type: its labels, with their descriptions.
+enumeration :: forall a. (Options a, Eq a) => Codec a
+enumeration =
+  Codec
+    (documentSchema' (optionsDoc set) (schemaOf (SEnum [(optionLabel o, optionDoc o) | o <- opts])))
+    (\a -> maybe Null (String . optionLabel) (find ((== a) . optionValue) opts))
+    ( \case
+        String t | Just o <- find ((== t) . optionLabel) opts -> Right (optionValue o)
+        v -> mismatch ("one of " <> T.intercalate ", " (map optionLabel opts)) v
+    )
+  where
+    set = options @a
+    opts = optionList set
+
+class GEnum (f :: Type -> Type) where
+  genum :: [f p]
+
+instance GEnum f => GEnum (M1 D d f) where
+  genum = map M1 genum
+
+instance (GEnum f, GEnum g) => GEnum (f :+: g) where
+  genum = map L1 genum <> map R1 genum
+
+instance GEnum (M1 C c U1) where
+  genum = [M1 U1]
+
+class GConName (f :: Type -> Type) where
+  gconName :: f p -> String
+
+instance GConName f => GConName (M1 D d f) where
+  gconName (M1 x) = gconName x
+
+instance (GConName f, GConName g) => GConName (f :+: g) where
+  gconName = \case
+    L1 x -> gconName x
+    R1 x -> gconName x
+
+instance Constructor c => GConName (M1 C c f) where
+  gconName = conName
diff --git a/src/Agentic/Core.hs b/src/Agentic/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Core.hs
@@ -0,0 +1,175 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+-- | Flows: typed, inspectable descriptions of agentic work.
+module Agentic.Core
+  ( -- * Flows
+    Agentic (..)
+  , Step (..)
+  , Tool (..)
+  , Note (..)
+  , Instruction (..)
+    -- * Steps
+  , draft
+  , draftWith
+  , judge
+  , act
+    -- * Tools
+  , tool
+    -- * Structure
+  , each
+  , repeatUntil
+  , note
+  , named
+    -- * Judgement helpers
+  , keep
+  , gate
+    -- * Re-exports
+  , module Control.Arrow
+  ) where
+
+import Agentic.Contract (Codec (..), Contract (..))
+import Agentic.Questions (Probability, Questions, YesNo (..))
+import Control.Arrow
+import qualified Control.Category as Category
+import Data.String (IsString (..))
+import Agentic.Schema (titled)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Typeable (Typeable, typeRep)
+import Data.Proxy (Proxy (..))
+
+-- | What a model step is asked to do.
+newtype Instruction = Instruction {instructionText :: Text}
+  deriving (Eq, Ord, Show)
+
+instance IsString Instruction where
+  fromString = Instruction . T.pack
+
+-- | 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
+  }
+  deriving (Eq, Ord, Show)
+
+-- | The leaves of a flow: the steps that do the work.
+data Step m i o where
+  Pass :: Step m i i
+    -- ^ The input, unchanged: 'id' and 'returnA'.
+  Wrap :: (i -> o) -> Step m i o
+    -- ^ 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
+  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
+
+-- | A flow from @i@ to @o@ in effect @m@. Build flows from steps with the
+-- 'Arrow' combinators; run them with 'Agentic.Interpret.interpret'.
+data Agentic m i o where
+  Step :: Step m i o -> Agentic m i o
+  Seq :: Agentic m a b -> Agentic m b c -> Agentic m a c
+  Fanout :: Agentic m a b -> Agentic m a c -> Agentic m a (b, c)
+  Split :: Agentic m a b -> Agentic m c d -> Agentic m (a, c) (b, d)
+  First :: Agentic m a b -> Agentic m (a, c) (b, c)
+  Choose :: Agentic m a c -> Agentic m b c -> Agentic m (Either a b) c
+  Each :: Agentic m a b -> Agentic m [a] [b]
+  Repeat :: (a -> Bool) -> Agentic m a a -> Agentic m a a
+  Noted :: Note -> Agentic m i o -> Agentic m i o
+
+-- | A named flow a model can call.
+data Tool m where
+  Tool :: {toolName :: Text, toolDescription :: Text, toolInput :: Codec i, toolOutput :: Codec o, toolBody :: Agentic m i o} -> Tool m
+
+instance Category.Category (Agentic m) where
+  id = Step Pass
+  g . f = Seq f g
+
+-- The overrides keep the structure visible to 'Agentic.Describe.describe'
+-- instead of the defaults' plumbing through @arr swap@.
+instance Arrow (Agentic m) where
+  arr = Step . Arr
+  first = First
+  second = Split (Step Pass)
+  (***) = Split
+  f &&& g = Fanout f g
+
+instance ArrowChoice (Agentic m) where
+  left f = Choose (f >>> Step (Wrap Left)) (Step (Wrap Right))
+  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
+
+-- | An LLM writes an @o@ from the step's input.
+--
+-- > draft @Joke "a joke please"
+draft :: forall o i m. (Contract i, Contract o, Typeable i, Typeable o) => Instruction -> Agentic m i o
+draft = draftWith @o []
+
+-- | An LLM writes an @o@, calling the tools as often as it likes along the way.
+draftWith :: forall o i m. (Contract i, Contract o, Typeable i, Typeable o) => [Tool m] -> Instruction -> Agentic m i o
+draftWith tools instruction = Step (Draft (titledContract @i) (titledContract @o) instruction tools)
+
+-- | A System One model answers questions about the step's input.
+judge :: forall i o m. (Contract i, Typeable i) => Questions o -> Agentic m i o
+judge = Step . Judge (titledContract @i)
+
+-- | Plain code with an effect.
+act :: (i -> m o) -> Agentic m i o
+act = Step . Act
+
+-- | A tool: a name and description for the model, and a flow to run.
+tool :: forall i o m. (Contract i, Contract o, Typeable i, Typeable o) => Text -> Text -> Agentic m i o -> Tool m
+tool name description = Tool name description (titledContract @i) (titledContract @o)
+
+-- | 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
+
+-- | Map a flow over a list. The runtime may run the items concurrently.
+each :: Agentic m a b -> Agentic m [a] [b]
+each = Each
+
+-- | Run a flow again and again on its own output until the condition holds.
+-- The condition is checked first, so an input that already satisfies it is
+-- returned unchanged. The model decides how many rounds it takes; name the
+-- loop to say what it waits for:
+--
+-- > repeatUntil ended nextMove `named` "play until the game ends"
+repeatUntil :: (a -> Bool) -> Agentic m a a -> Agentic m a a
+repeatUntil = Repeat
+
+-- | Name and describe a sub-flow.
+note :: Text -> Text -> Agentic m i o -> Agentic m i o
+note name description = Noted (Note name (if T.null description then Nothing else Just description))
+
+-- | Name a flow. Written infix, it names exactly the expression before it,
+-- because it binds as tightly as function application:
+--
+-- > draft @[Creature] "Name 10 prehistoric creatures"
+-- >   >>> arr (partition clearDinosaur) `named` "keep the clear dinosaurs"
+-- >   >>> ...
+--
+-- Bracket a larger sub-flow to name all of it.
+named :: Agentic m i o -> Text -> Agentic m i o
+f `named` name = Noted (Note name Nothing) f
+
+infixl 9 `named`
+
+-- | Keep the items where the probability of yes is at least @p@.
+keep :: (Contract i, Typeable i) => Probability -> Questions YesNo -> Agentic m [i] [i]
+keep p q =
+  note ("keep " <> T.pack (show p)) "" $
+    each (returnA &&& judge q)
+      >>> arr (map fst . filter ((>= p) . yes . snd))
+
+-- | Send the input 'Right' if the probability of yes is at least @p@, and
+-- 'Left' otherwise.
+gate :: (Contract i, Typeable i) => Probability -> Questions YesNo -> Agentic m i (Either i i)
+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)
diff --git a/src/Agentic/Describe.hs b/src/Agentic/Describe.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Describe.hs
@@ -0,0 +1,492 @@
+-- | Looking at a flow without running it.
+module Agentic.Describe
+  ( describe
+  , Description (..)
+  , StepInfo (..)
+  , ToolInfo (..)
+  , renderTree
+  , mermaid
+  , dot
+  , flowGraph
+  , FlowGraph (..)
+  , Item (..)
+  , NodeKind (..)
+  , Edge (..)
+  , EdgeStyle (..)
+  , toValue
+  ) where
+
+import Agentic.Contract (Codec (..))
+import Agentic.Core
+import Agentic.Questions (QuestionSpec (..), Questions (..))
+import Agentic.Schema (Schema, typeLabel)
+import Agentic.Value (Value (..))
+import Data.List (mapAccumL)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+data Description
+  = Leaf StepInfo
+  | Sequence [Description]
+    -- ^ @a >>> b >>> c@, flattened.
+  | Together [Description]
+    -- ^ @a &&& b &&& c@, flattened.
+  | Halves Description Description
+    -- ^ @a *** b@: one flow on each half of a pair.
+  | Branch Description Description
+  | ForEach Description
+  | Repeated Description
+    -- ^ @repeatUntil@: run again on its own output until a condition holds.
+  | Annotated Note Description
+
+data StepInfo
+  = Identity
+    -- ^ The input, unchanged ('returnA').
+  | Glue
+    -- ^ @arr@: a pure function.
+  | Effect
+    -- ^ @act@: plain code with an effect.
+  | DraftInfo
+      { draftInstruction :: Instruction
+      , draftInput :: Schema
+      , draftOutput :: Schema
+      , draftTools :: [ToolInfo]
+      }
+  | JudgeInfo
+      { judgeState :: Schema
+      , judgeQuestions :: [QuestionSpec]
+      }
+
+data ToolInfo = ToolInfo
+  { infoName :: Text
+  , infoDescription :: Text
+  , infoInput :: Schema
+  , infoOutput :: Schema
+  , infoBody :: Description
+  }
+
+-- | Describe a flow. This never runs anything.
+describe :: Agentic m i o -> Description
+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))
+  Split f g -> Halves (describe f) (describe g)
+  First f -> Halves (describe f) (Leaf Identity)
+  Choose f g -> Branch (describe f) (describe g)
+  Each f -> ForEach (describe f)
+  Repeat _ f -> Repeated (describe f)
+  Noted n f -> Annotated n (describe f)
+  where
+    sequenced = \case
+      Sequence ds -> ds
+      d -> [d]
+    together = \case
+      Together ds -> ds
+      d -> [d]
+
+stepInfo :: Step m i o -> StepInfo
+stepInfo = \case
+  Pass -> Identity
+  Wrap _ -> Identity
+  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)
+
+toolInfo :: Tool m -> ToolInfo
+toolInfo (Tool name description input out body) =
+  ToolInfo name description (codecSchema input) (codecSchema out) (describe body)
+
+-- ---------------------------------------------------------------------------
+-- The tree view
+
+instance Show Description where
+  show = T.unpack . renderTree
+
+data Tree = Node Text [Tree]
+
+-- | The tree view. Each tool's body is expanded the first time the tool
+-- appears. Unnamed glue between steps is hidden, but a branch is never hidden:
+-- inside @&&&@, @***@ and @|||@ it shows as @arr@ (or @pass@ for 'returnA'), and
+-- a pass-through beside a step shows as "keeping its input".
+renderTree :: Description -> Text
+renderTree = T.intercalate "\n" . concatMap (draw "" "") . snd . trees []
+
+-- | Convert to trees, threading the names of tools already expanded.
+trees :: [Text] -> Description -> ([Text], [Tree])
+trees seen = \case
+  Leaf Identity -> (seen, [])
+  Leaf Glue -> (seen, [])
+  Leaf info -> leaf Nothing info
+  Sequence ds -> concat <$> mapAccumL trees seen ds
+  Together ds ->
+    let keeping = if any passes ds then "  (keeping its input)" else ""
+     in case concat <$> mapAccumL parallel seen (filter (not . passes) ds) of
+          (seen', [Node t cs]) -> (seen', [Node (t <> keeping) cs])
+          (seen', ts) -> (seen', [Node ("together" <> keeping) ts])
+  Halves l r ->
+    let (seen1, ls) = branch seen l
+        (seen2, rs) = branch seen1 r
+     in (seen2, [Node "both halves" [labelled "first" ls, labelled "second" rs]])
+  Branch l r ->
+    let (seen1, ls) = branch seen l
+        (seen2, rs) = branch seen1 r
+     in (seen2, [Node "branch" [labelled "left" ls, labelled "right" rs]])
+  Repeated d -> case branch seen d of
+    (seen', [Node "together" ts]) -> (seen', [Node "repeatUntil" ts])
+    (seen', ts) -> (seen', [Node "repeatUntil" ts])
+  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 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])
+  where
+    -- A step: what kind it is, then its name, then the details.
+    leaf name info =
+      let (seen', toolTrees) = case info of
+            DraftInfo _ _ _ tools -> mapAccumL toolTree seen tools
+            _ -> (seen, [])
+       in (seen', [Node (T.intercalate "  " (stepLines name info)) toolTrees])
+    -- A branch of @&&&@ that's several steps in a row is grouped, so its steps
+    -- don't read as more parallel branches.
+    parallel s d = case branch s d of
+      (s', ts@(_ : _ : _)) -> (s', [Node "in order" ts])
+      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") []])
+      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)
+    labelled l = \case
+      [Node t cs] -> Node (l <> " → " <> t) cs
+      [] -> Node (l <> " → pass") []
+      ts -> Node l ts
+
+-- | Does this part of a flow only pass its input through?
+passes :: Description -> Bool
+passes = \case
+  Leaf Identity -> True
+  Sequence ds -> all passes ds
+  Annotated _ d -> passes d
+  _ -> False
+
+questionText :: QuestionSpec -> Text
+questionText = \case
+  AskYesNo q -> "yes/no " <> quoted q
+  AskChoice q opts -> "choice of " <> T.pack (show (length opts)) <> " " <> quoted q
+  AskScore q levels -> "score on " <> T.pack (show (length levels)) <> " levels " <> quoted q
+
+quoted :: Text -> Text
+quoted t = "\"" <> t <> "\""
+
+draw :: Text -> Text -> Tree -> [Text]
+draw lead childLead (Node t cs) = (lead <> t) : go cs
+  where
+    go = \case
+      [] -> []
+      [c] -> draw (childLead <> "└─ ") (childLead <> "   ") c
+      c : rest -> draw (childLead <> "├─ ") (childLead <> "│  ") c <> go rest
+
+-- ---------------------------------------------------------------------------
+-- Mermaid
+
+-- | How data moves through a flow, as a graph: steps joined in order; @&&&@,
+-- @***@ and @|||@ forking into their branches and joining again at the next
+-- step, with a pass-through drawn as an edge straight to the join; @each@,
+-- @repeatUntil@ and named sub-flows as boxes; tools hanging off their draft.
+-- 'mermaid' and 'dot' render it.
+data FlowGraph = FlowGraph
+  { graphItems :: [Item]
+  , graphEdges :: [Edge]
+  }
+
+-- | A node, or a box of items.
+data Item
+  = ItemNode Text NodeKind [Text]
+    -- ^ An id, what kind of node it is, and its label's lines.
+  | ItemBox Text [Text] [Item]
+    -- ^ An id, its label's lines, and what's inside.
+
+data NodeKind = Terminal | StepNode | ToolNode
+
+data Edge = Edge
+  { edgeFrom :: Text
+  , edgeTo :: Text
+    -- ^ A node, or a box's id.
+  , edgeLabel :: Maybe Text
+  , edgeStyle :: 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
+  (_, BuildState _ open edges) -> FlowGraph (reverse (concat open)) (reverse edges)
+  where
+    flow = do
+      item (ItemNode "input" Terminal ["input"])
+      exits <- build InSequence [("input", Nothing)] d
+      item (ItemNode "output" Terminal ["output"])
+      connect exits "output"
+
+-- | Where a description sits: unnamed glue between steps is plumbing, but a
+-- 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)]
+
+-- | A counter for ids, the items of each open box (innermost first), and edges.
+data BuildState = BuildState Int [[Item]] [Edge]
+
+newtype Build a = Build {runBuild :: BuildState -> (a, BuildState)}
+
+instance Functor Build where
+  fmap f (Build g) = Build (\s -> let (a, s') = g s in (f a, s'))
+
+instance Applicative Build where
+  pure a = Build (\s -> (a, s))
+  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)
+
+fresh :: Build Text
+fresh = Build (\(BuildState n open es) -> ("n" <> T.pack (show n), BuildState (n + 1) open es))
+
+item :: Item -> Build ()
+item i = Build $ \case
+  BuildState n (current : outer) es -> ((), BuildState n ((i : current) : outer) es)
+  BuildState n [] es -> ((), BuildState n [[i]] es)
+
+edge :: Edge -> Build ()
+edge e = Build (\(BuildState n open es) -> ((), BuildState n open (e : es)))
+
+edgeCount :: Build Int
+edgeCount = Build (\s@(BuildState _ _ es) -> (length es, s))
+
+-- | The nodes that edges added since @before@ lead into from these sources.
+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)
+  where
+    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
+
+node :: From -> [Text] -> Build From
+node from label = do
+  n <- fresh
+  item (ItemNode n StepNode label)
+  connect from n
+  pure [(n, Nothing)]
+
+box :: [Text] -> Build a -> Build (Text, a)
+box label inside = do
+  b <- fresh
+  Build (\(BuildState n open es) -> ((), BuildState n ([] : open) es))
+  a <- inside
+  Build $ \case
+    BuildState n (contents : parent : outer) es -> ((), BuildState n ((ItemBox b label (reverse contents) : parent) : outer) es)
+    s -> ((), s)
+  pure (b, a)
+
+build :: Context -> From -> Description -> Build From
+build context from = \case
+  Leaf Identity -> pure from
+  Leaf Glue -> case context of
+    InSequence -> pure 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)
+  -- "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)
+    let targets = if null entries then [b] else entries
+    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)
+  where
+    labelled l = [(f, Just l) | (f, _) <- from]
+    chain acc = \case
+      [] -> pure acc
+      x : xs -> build InSequence acc x >>= (`chain` xs)
+    -- 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
+            (kind : name : details, Just description) -> kind : name : description : details
+            (ls, _) -> ls
+      exits <- node from lines''
+      case info of
+        DraftInfo _ _ _ tools ->
+          mapM_
+            ( \t -> do
+                n <- fresh
+                item (ItemNode n ToolNode ["tool " <> infoName t])
+                mapM_ (\(e, _) -> edge (Edge e n Nothing Uses)) exits
+            )
+            tools
+        _ -> pure ()
+      pure exits
+
+-- | How a step is labelled, everywhere: what kind of step it is, then its name
+-- if it has one, then its details (an instruction, or questions).
+stepLines :: Maybe Text -> StepInfo -> [Text]
+stepLines name info = kind : maybe [] pure name <> details
+  where
+    (kind, details) = case info of
+      Identity -> ("pass", [])
+      Glue -> ("arr", [])
+      Effect -> ("act", [])
+      DraftInfo instruction _ out _ -> ("draft @" <> typeLabel out, [quoted (instructionText instruction)])
+      JudgeInfo _ [q] -> ("judge", [questionText q])
+      JudgeInfo _ qs -> ("judge " <> T.pack (show (length qs)) <> " questions in one request", map questionText qs)
+
+-- | A Mermaid flowchart of the flow's graph.
+mermaid :: Description -> Text
+mermaid d = T.unlines ("flowchart TD" : concatMap (items' "  ") is <> map edge' es)
+  where
+    FlowGraph is es = flowGraph d
+    items' indent = \case
+      ItemNode i kind ls -> [indent <> i <> shape kind (T.intercalate "<br/>" (map escape ls))]
+      ItemBox i ls inside -> [indent <> "subgraph " <> i <> "[\"" <> T.intercalate "<br/>" (map escape ls) <> "\"]"] <> concatMap (items' (indent <> "  ")) inside <> [indent <> "end"]
+    shape kind l = case kind of
+      Terminal -> "([\"" <> l <> "\"])"
+      StepNode -> "[\"" <> l <> "\"]"
+      ToolNode -> "[/\"" <> l <> "\"/]"
+    edge' (Edge f t l style) = "  " <> f <> arrow style <> maybe "" (\x -> "|" <> escape x <> "|") l <> " " <> t
+    arrow = \case
+      Flow -> " -->"
+      Uses -> " -.-"
+      Again -> " -.->"
+    escape = T.replace "\"" "#quot;"
+
+-- | A Graphviz DOT digraph of the flow's graph. Render it with, for example,
+-- @dot -Tsvg@.
+dot :: Description -> Text
+dot d =
+  T.unlines $
+    ["digraph flow {", "  compound=true;", "  node [shape=box, style=rounded, fontname=\"Helvetica\"];", "  edge [fontname=\"Helvetica\"];"]
+      <> concatMap (items' "  ") is
+      <> map edge' es
+      <> ["}"]
+  where
+    FlowGraph is es = flowGraph d
+    items' indent = \case
+      ItemNode i kind ls -> [indent <> i <> " [label=\"" <> T.intercalate "\\n" (map inner ls) <> "\"" <> shape kind <> "];"]
+      ItemBox i ls inside -> [indent <> "subgraph cluster_" <> i <> " {", indent <> "  label=\"" <> T.intercalate "\\n" (map inner ls) <> "\";", indent <> "  style=rounded;"] <> concatMap (items' (indent <> "  ")) inside <> [indent <> "}"]
+    shape = \case
+      Terminal -> ", shape=oval"
+      StepNode -> ""
+      ToolNode -> ", shape=parallelogram, style=\"\""
+    -- An edge into a box points at the box's first node, clipped to the box.
+    edge' (Edge f t l style) =
+      let (target, attrs) = case firstNode t is of
+            Just n
+              | inBox t f is -> (n, [])
+              | otherwise -> (n, ["lhead=cluster_" <> t])
+            Nothing -> (t, [])
+          extra = maybe [] (\x -> ["label=" <> str x]) l <> attrs <> styleOf style
+       in "  " <> f <> " -> " <> target <> (if null extra then "" else " [" <> T.intercalate ", " extra <> "]") <> ";"
+    styleOf = \case
+      Flow -> []
+      Uses -> ["style=dotted", "arrowhead=none"]
+      Again -> ["style=dashed"]
+    str t = "\"" <> inner t <> "\""
+    inner = T.concatMap (\case '"' -> "\\\""; '\\' -> "\\\\"; c -> T.singleton c)
+
+-- | Is the node with this id inside the box with that id?
+inBox :: Text -> Text -> [Item] -> Bool
+inBox b n = any within
+  where
+    within = \case
+      ItemBox i _ inside
+        | i == b -> any contains inside
+        | otherwise -> any within inside
+      ItemNode {} -> False
+    contains = \case
+      ItemNode i _ _ -> i == n
+      ItemBox _ _ inside -> any contains inside
+
+-- | The first node inside the box with this id, if the id is a box's. Only an
+-- edge into an empty loop needs it.
+firstNode :: Text -> [Item] -> Maybe Text
+firstNode b = go
+  where
+    go = \case
+      [] -> Nothing
+      ItemBox i _ inside : rest
+        | i == b -> first inside
+        | otherwise -> maybe (go rest) Just (go inside)
+      ItemNode {} : rest -> go rest
+    first = \case
+      ItemNode i _ _ : _ -> Just i
+      ItemBox _ _ inside : rest -> maybe (first rest) Just (first inside)
+      [] -> Nothing
+
+-- ---------------------------------------------------------------------------
+-- JSON
+
+-- | The description as a JSON-shaped value, for UIs and other agents.
+toValue :: Description -> Value
+toValue = \case
+  Leaf info -> leaf info
+  Sequence ds -> node "sequence" [("steps", Array (map toValue ds))]
+  Together ds -> node "together" [("steps", Array (map toValue ds))]
+  Halves l r -> node "halves" [("first", toValue l), ("second", toValue r)]
+  Branch l r -> node "branch" [("left", toValue l), ("right", toValue r)]
+  ForEach d -> node "each" [("step", toValue d)]
+  Repeated d -> node "repeat" [("step", toValue d)]
+  Annotated n d ->
+    node "note" $
+      [("name", String (noteName n))]
+        <> maybe [] (\t -> [("description", String t)]) (noteDescription n)
+        <> [("step", toValue d)]
+  where
+    node kind fields = Object (("kind", String kind) : fields)
+    leaf = \case
+      Identity -> node "pass" []
+      Glue -> node "arr" []
+      Effect -> node "act" []
+      DraftInfo instruction input out tools ->
+        node
+          "draft"
+          [ ("instruction", String (instructionText instruction))
+          , ("input", String (typeLabel input))
+          , ("output", String (typeLabel out))
+          , ("tools", Array (map tool tools))
+          ]
+      JudgeInfo input qs ->
+        node "judge" [("state", 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)))
+        ]
+    question = \case
+      AskYesNo q -> Object [("type", String "yesNo"), ("question", String q)]
+      AskChoice q opts -> Object [("type", String "choice"), ("question", String q), ("options", Array [String l | (l, _) <- opts])]
+      AskScore q levels -> Object [("type", String "score"), ("question", String q), ("levels", Array [String l | (l, _) <- levels])]
diff --git a/src/Agentic/Interpret.hs b/src/Agentic/Interpret.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Interpret.hs
@@ -0,0 +1,97 @@
+-- | Running flows.
+module Agentic.Interpret
+  ( interpret
+  ) where
+
+import Agentic.Contract (Codec (..))
+import Agentic.Core
+import Agentic.Questions (JudgeRequest (..), Questions (..), decodeAnswers)
+import Agentic.Runtime
+import Data.List (find)
+
+-- | Run a flow with a runtime.
+interpret :: forall m i o. Monad m => Runtime m -> Agentic m i o -> i -> m o
+interpret rt = go []
+  where
+    go :: forall a b. [Note] -> Agentic m a b -> a -> m b
+    go path flow x = case flow of
+      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]
+        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]
+          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)
+      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
+
+    step :: forall a b. [Note] -> Step m a b -> a -> m b
+    step path s x = case s of
+      Pass -> pure x
+      Wrap f -> pure (f x)
+      Arr f -> pure (f x)
+      Act f -> emit path Acted >> f x
+      Judge input qs
+        | null (specs qs) -> answered (decodeAnswers qs [])
+        | otherwise -> do
+            let request = JudgeRequest (encode input x) (specs qs)
+            answers <- askSystemOne (systemOne rt) request
+            emit path (Judged request answers)
+            answered (decodeAnswers qs answers)
+      Draft input out instruction tools -> do
+        let conversation =
+              Conversation
+                { path = path
+                , instruction = instruction
+                , state = encode input x
+                , stateSchema = codecSchema input
+                , tools = map toolSpec tools
+                , output = codecSchema out
+                , history = []
+                }
+        emit path (Drafting conversation)
+        let loop past = do
+              turn <- askSystemTwo (systemTwo rt) conversation {history = past}
+              emit path (Turned turn)
+              case action turn of
+                Respond v -> case decode out v of
+                  Right b -> pure b
+                  Left problem -> do
+                    emit path (OutputRejected problem)
+                    loop (past <> [Rejected (raw turn) problem])
+                CallTools calls -> do
+                  results <- parallel rt (map (runTool path tools) calls)
+                  loop (past <> [Called (raw turn) (zip (map callId calls) results)])
+        loop []
+      where
+        answered = either (failure rt . MalformedAnswers) pure
+
+    runTool :: [Note] -> [Tool m] -> ToolCall -> m ToolResult
+    runTool path tools call = do
+      emit path (ToolCalled call)
+      result <- case find ((== callName call) . nameOf) tools of
+        Nothing -> pure (ToolFailed ("there is no tool named " <> callName call))
+        Just (Tool name _ input out body) -> case decode input (callInput call) 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)
+      pure result
+      where
+        nameOf (Tool name _ _ _ _) = name
+
+toolSpec :: Tool m -> ToolSpec
+toolSpec (Tool name description input _ _) = ToolSpec name description (codecSchema input)
diff --git a/src/Agentic/Questions.hs b/src/Agentic/Questions.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Questions.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+-- | Questions for a System One model such as Jev. Following Jev's terms, a step
+-- asks t'Questions' about its input, the /state/.
+module Agentic.Questions
+  ( -- * Questions
+    Questions (..)
+  , yesNo
+  , choice
+  , score
+    -- * Answers
+  , Probability
+  , probability
+  , fromBasisPoints
+  , basisPoints
+  , YesNo (..)
+  , Choice (..)
+  , Score (..)
+    -- * Wire types
+  , QuestionSpec (..)
+  , Answer (..)
+  , JudgeRequest (..)
+  , decodeAnswers
+  ) where
+
+import Agentic.Contract (Contract (..), Option (..), OptionSet (..), Options (..), mapCodec, record, required)
+import Agentic.Value (Value (..))
+import Data.List (find)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- ---------------------------------------------------------------------------
+-- Probabilities
+
+-- | A probability, held as basis points (0–10000) so that results replay and
+-- compare exactly. Write literals directly: @0.9 :: Probability@.
+newtype Probability = Probability Int
+  deriving (Eq, Ord)
+
+instance Show Probability where
+  show p = show (probability p)
+
+instance Num Probability where
+  Probability a + Probability b = clamp (a + b)
+  Probability a - Probability b = clamp (a - b)
+  Probability a * Probability b = clamp ((a * b) `div` 10000)
+  abs = id
+  signum (Probability a) = Probability (if a > 0 then 10000 else 0)
+  fromInteger n = clamp (fromInteger n * 10000)
+
+instance Fractional Probability where
+  fromRational r = clamp (round (r * 10000))
+  Probability a / Probability b = clamp ((a * 10000) `div` max 1 b)
+
+clamp :: Int -> Probability
+clamp = Probability . max 0 . min 10000
+
+probability :: Probability -> Double
+probability (Probability bp) = fromIntegral bp / 10000
+
+-- | Convert a provider's probability, rounding once (half to even).
+fromBasisPoints :: Double -> Probability
+fromBasisPoints d = clamp (round (d * 10000))
+
+basisPoints :: Probability -> Int
+basisPoints (Probability bp) = bp
+
+-- ---------------------------------------------------------------------------
+-- Answers
+
+-- | Jev's Noul: the probability that the answer is yes.
+newtype YesNo = YesNo {yes :: Probability}
+  deriving (Eq, Show)
+
+data Choice a = Choice
+  { chosen :: a
+  , choiceProbabilities :: [(a, Probability)]
+  , choiceConfidence :: 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
+  }
+  deriving (Eq, Show)
+
+-- Answers have contracts, so a judgement can be a tool's output.
+
+instance Contract Probability where
+  contract = mapCodec fromBasisPoints probability (contract @Double)
+
+instance Contract YesNo where
+  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
+
+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
+
+-- ---------------------------------------------------------------------------
+-- Wire types
+
+data QuestionSpec
+  = AskYesNo Text
+  | AskChoice Text [(Text, Maybe Text)]
+    -- ^ Option labels with their descriptions.
+  | AskScore Text [(Text, Maybe Text)]
+    -- ^ Levels in order, lowest first.
+  deriving (Eq, Ord, Show)
+
+data Answer
+  = YesNoAnswer Probability
+  | ChoiceAnswer Text [(Text, Probability)] Probability
+    -- ^ The chosen label, every label's probability, and the confidence.
+  | ScoreAnswer Double [(Int, Probability)] Probability
+    -- ^ The position, each level's probability (by index), and the confidence.
+  deriving (Eq, Show)
+
+-- | What a System One provider receives: the encoded state and the questions.
+data JudgeRequest = JudgeRequest
+  { requestState :: Value
+  , requestQuestions :: [QuestionSpec]
+  }
+  deriving (Eq, Ord, Show)
+
+-- ---------------------------------------------------------------------------
+-- Questions
+
+-- | One or more questions about the same state, sent as one request. Combine
+-- them applicatively:
+--
+-- > judge (Review <$> funny <*> groan)
+data Questions a = Questions
+  { specs :: [QuestionSpec]
+  , decoder :: [Answer] -> Either Text a
+  }
+
+instance Functor Questions where
+  fmap f q = q {decoder = fmap f . decoder q}
+
+instance Applicative Questions where
+  pure x = Questions [] (\case [] -> Right x; _ -> Left "too many answers")
+  Questions l dl <*> Questions r dr = Questions (l <> r) $ \answers ->
+    let (before, after) = splitAt (length l) answers
+     in dl before <*> dr after
+
+decodeAnswers :: Questions a -> [Answer] -> Either Text a
+decodeAnswers = decoder
+
+single :: QuestionSpec -> (Answer -> Either Text a) -> Questions a
+single spec decode = Questions [spec] $ \case
+  [answer] -> decode answer
+  answers -> Left ("expected one answer, got " <> T.pack (show (length answers)))
+
+-- | Jev's Noul primitive: how likely is it that the answer is yes?
+yesNo :: Text -> Questions YesNo
+yesNo q = single (AskYesNo q) $ \case
+  YesNoAnswer p -> Right (YesNo p)
+  other -> Left ("expected a yes/no answer, got " <> T.pack (show other))
+
+-- | Pick one of an 'Options' type's values.
+choice :: forall a. Options a => Text -> Questions (Choice a)
+choice q = single (AskChoice q (labels opts)) $ \case
+  ChoiceAnswer picked ps conf ->
+    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)
+
+-- | Place the state on an 'Options' type's levels, lowest first.
+score :: forall a. Options a => Text -> Questions (Score a)
+score q = single (AskScore q (labels opts)) $ \case
+  ScoreAnswer pos ps conf ->
+    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)
+    byIndex i = case drop i opts of
+      o : _ | i >= 0 -> Right (optionValue o)
+      _ -> Left ("no level " <> T.pack (show i))
+
+labels :: [Option a] -> [(Text, Maybe Text)]
+labels = map (\o -> (optionLabel o, optionDoc o))
+
+byLabel :: [Option a] -> Text -> Either Text a
+byLabel opts l = maybe (Left ("unknown option " <> l)) (Right . optionValue) (find ((== l) . optionLabel) opts)
diff --git a/src/Agentic/Runtime.hs b/src/Agentic/Runtime.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Runtime.hs
@@ -0,0 +1,187 @@
+-- | The runtime: the one connection between a flow and the outside world.
+module Agentic.Runtime
+  ( -- * Runtime
+    Runtime (..)
+  , runtime
+  , runtimeWith
+  , SystemOne (..)
+  , SystemTwo (..)
+  , ProvidesSystemOne (..)
+  , ProvidesSystemTwo (..)
+  , withSystemOne
+  , withSystemTwo
+    -- * Modifiers
+  , observing
+  , capped
+    -- * System Two turns
+  , Conversation (..)
+  , ToolSpec (..)
+  , Exchange (..)
+  , ToolResult (..)
+  , Turn (..)
+  , Raw (..)
+  , Action (..)
+  , ToolCall (..)
+    -- * Events and errors
+  , Event (..)
+  , Happened (..)
+  , FlowError (..)
+  ) where
+
+import Agentic.Core (Instruction, Note)
+import Agentic.Questions (Answer, JudgeRequest)
+import Agentic.Schema (Schema)
+import Agentic.Value (Value (..))
+import Control.Exception (Exception, throwIO)
+import Data.Text (Text)
+
+-- ---------------------------------------------------------------------------
+-- System Two turns
+
+-- | Everything a System Two provider needs to take one turn of a step.
+data Conversation = Conversation
+  { path :: [Note]
+    -- ^ Where this step is in the flow.
+  , instruction :: Instruction
+  , state :: Value
+    -- ^ The step's input, encoded by its contract.
+  , stateSchema :: Schema
+  , tools :: [ToolSpec]
+  , output :: Schema
+    -- ^ The schema of the step's result.
+  , history :: [Exchange]
+    -- ^ Earlier turns of this step, oldest first. Append-only.
+  }
+  deriving (Eq, Show)
+
+data ToolSpec = ToolSpec
+  { specName :: Text
+  , specDescription :: Text
+  , specInput :: Schema
+  }
+  deriving (Eq, Show)
+
+data Exchange
+  = Called Raw [(Text, ToolResult)]
+    -- ^ The model's turn, and the result of each tool call by call id.
+  | Rejected Raw Text
+    -- ^ The model's final value failed its contract's checks.
+  deriving (Eq, Show)
+
+data ToolResult = ToolOk Value | ToolFailed Text
+  deriving (Eq, Show)
+
+data Turn = Turn
+  { raw :: Raw
+  , action :: Action
+  }
+  deriving (Eq, Show)
+
+-- | A provider's own message for a turn. The core stores it and hands it back
+-- unchanged; only the provider looks inside.
+newtype Raw = Raw Value
+  deriving (Eq, Show)
+
+data Action
+  = CallTools [ToolCall]
+  | Respond Value
+  deriving (Eq, Show)
+
+data ToolCall = ToolCall
+  { callId :: Text
+  , callName :: Text
+  , callInput :: Value
+  }
+  deriving (Eq, Show)
+
+-- ---------------------------------------------------------------------------
+-- Events and errors
+
+data Event = Event
+  { eventPath :: [Note]
+  , happened :: Happened
+  }
+  deriving (Show)
+
+data Happened
+  = Drafting Conversation
+  | Turned Turn
+  | ToolCalled ToolCall
+  | ToolReturned Text ToolResult
+  | OutputRejected Text
+  | Judged JudgeRequest [Answer]
+  | Acted
+  deriving (Show)
+
+-- | Errors the core raises itself. Provider errors are the provider's own.
+data FlowError
+  = NoSystemOne
+  | NoSystemTwo
+  | MalformedAnswers Text
+  | TurnLimit Int
+  deriving (Eq, Show)
+
+instance Exception FlowError
+
+-- ---------------------------------------------------------------------------
+-- Runtime
+
+-- | Fast, typed judgements (Jev, or an LLM standing in).
+newtype SystemOne m = SystemOne {askSystemOne :: JudgeRequest -> m [Answer]}
+
+-- | One LLM turn.
+newtype SystemTwo m = SystemTwo {askSystemTwo :: 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.
+data Runtime m = Runtime
+  { systemOne :: SystemOne m
+  , systemTwo :: SystemTwo m
+  , parallel :: forall a. [m a] -> m [a]
+    -- ^ Runs independent work: 'Agentic.Core.each', 'Control.Arrow.&&&', parallel tool calls.
+  , observe :: Event -> m ()
+  , failure :: forall a. FlowError -> m a
+  }
+
+-- | A runtime in IO with no providers: it runs things one after another,
+-- observes nothing, and throws 'FlowError's.
+runtime :: Runtime IO
+runtime = runtimeWith throwIO
+
+-- | A runtime in any monad, given how it raises errors.
+runtimeWith :: Monad m => (forall a. FlowError -> m a) -> Runtime m
+runtimeWith raise =
+  Runtime
+    { systemOne = SystemOne (const (raise NoSystemOne))
+    , systemTwo = SystemTwo (const (raise NoSystemTwo))
+    , parallel = sequence
+    , observe = const (pure ())
+    , failure = raise
+    }
+
+class ProvidesSystemOne p where
+  toSystemOne :: p -> IO (SystemOne IO)
+
+class ProvidesSystemTwo p where
+  toSystemTwo :: p -> IO (SystemTwo IO)
+
+withSystemOne :: ProvidesSystemOne p => p -> Runtime IO -> IO (Runtime IO)
+withSystemOne p rt = (\s -> rt {systemOne = s}) <$> toSystemOne p
+
+withSystemTwo :: ProvidesSystemTwo p => p -> Runtime IO -> IO (Runtime IO)
+withSystemTwo p rt = (\s -> rt {systemTwo = s}) <$> toSystemTwo p
+
+-- ---------------------------------------------------------------------------
+-- Modifiers
+
+-- | 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}
+
+-- | 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
diff --git a/src/Agentic/Schema.hs b/src/Agentic/Schema.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Schema.hs
@@ -0,0 +1,86 @@
+-- | The schema of a 'Agentic.Contract.Contract'. It's richer than any one
+-- provider's wire format; provider packages lower it to what they accept.
+module Agentic.Schema
+  ( Schema (..)
+  , Shape (..)
+  , Field (..)
+  , Variant (..)
+  , Format (..)
+  , schemaOf
+  , documentSchema
+  , typeLabel
+  , titled
+  ) where
+
+import Data.Text (Text)
+
+data Schema = Schema
+  { title :: Maybe Text
+    -- ^ The type's name, e.g. @Joke@. Providers use it to name schemas.
+  , doc :: Maybe Text
+  , checks :: [Text]
+    -- ^ Constraints the wire schemas can't express, stated for the model and
+    -- checked locally.
+  , shape :: Shape
+  }
+  deriving (Eq, Show)
+
+data Shape
+  = SObject [Field]
+  | SSum [Variant]
+    -- ^ A tagged union: each variant is an object with a @tag@ field.
+  | SEnum [(Text, Maybe Text)]
+    -- ^ A choice of labels, each with an optional description.
+  | SArray Schema
+  | SNullable Schema
+  | SString (Maybe Format)
+  | SInteger
+  | SNumber
+  | SBool
+  | SNull
+  deriving (Eq, Show)
+
+data Field = Field
+  { fieldName :: Text
+  , fieldSchema :: Schema
+  , fieldRequired :: Bool
+  }
+  deriving (Eq, Show)
+
+data Variant = Variant
+  { variantTag :: Text
+  , variantDoc :: Maybe Text
+  , variantFields :: [Field]
+  }
+  deriving (Eq, Show)
+
+data Format = DateTime | Date | Email | Uri | Uuid
+  deriving (Eq, Show)
+
+schemaOf :: Shape -> Schema
+schemaOf = Schema Nothing Nothing []
+
+documentSchema :: Text -> Schema -> Schema
+documentSchema d s = s {doc = Just d}
+
+-- | 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)}
+
+-- | A short label for display, e.g. in 'Agentic.Describe.describe'.
+typeLabel :: Schema -> Text
+typeLabel s = maybe (structural (shape s)) id (title s)
+  where
+    structural = \case
+      SObject _ -> "object"
+      SSum [] -> "sum"
+      SSum vs -> "sum of " <> joinTags (map variantTag vs)
+      SEnum ls -> "one of " <> joinTags (map fst ls)
+      SArray inner -> "[" <> typeLabel inner <> "]"
+      SNullable inner -> typeLabel inner <> "?"
+      SString _ -> "text"
+      SInteger -> "integer"
+      SNumber -> "number"
+      SBool -> "bool"
+      SNull -> "()"
+    joinTags ts = mconcat (zipWith (<>) ("" : repeat "|") ts)
diff --git a/src/Agentic/Scripted.hs b/src/Agentic/Scripted.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Scripted.hs
@@ -0,0 +1,52 @@
+-- | Providers for tests: the same flows, with no network.
+module Agentic.Scripted
+  ( -- * System Two
+    scripted
+  , replyingWith
+  , respond
+  , callTools
+    -- * System One
+  , answering
+  , alwaysYes
+  ) where
+
+import Agentic.Contract (Codec (..), Contract (..))
+import Agentic.Questions
+import Agentic.Runtime
+import Agentic.Value (Value (..))
+import Data.IORef (atomicModifyIORef', newIORef)
+import Data.Text (Text)
+
+-- | Take turns from a script, in order. Running out of script is an error.
+scripted :: [Action] -> IO (SystemTwo IO)
+scripted actions = do
+  ref <- newIORef actions
+  pure $ SystemTwo $ \_ -> do
+    next <- atomicModifyIORef' ref $ \case
+      a : rest -> (rest, Just a)
+      [] -> ([], Nothing)
+    maybe (fail "Agentic.Scripted: the script ran out of turns") (pure . Turn (Raw Null)) next
+
+-- | Answer each turn with a pure function of the conversation.
+replyingWith :: Applicative m => (Conversation -> Action) -> SystemTwo m
+replyingWith f = SystemTwo (pure . Turn (Raw Null) . f)
+
+-- | A final answer, encoded with its contract.
+respond :: Contract a => a -> Action
+respond = Respond . encode contract
+
+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)
+
+-- | Yes/no questions get probability @p@; choices and scores pick the first
+-- option with certainty.
+alwaysYes :: Applicative m => Probability -> SystemOne m
+alwaysYes p = answering $ \case
+  AskYesNo _ -> YesNoAnswer p
+  AskChoice _ ((l, _) : _) -> ChoiceAnswer l [(l, 1)] 1
+  AskChoice _ [] -> ChoiceAnswer "" [] 0
+  AskScore _ _ -> ScoreAnswer 0 [(0, 1)] 1
diff --git a/src/Agentic/Settings.hs b/src/Agentic/Settings.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Settings.hs
@@ -0,0 +1,49 @@
+-- | Settings that several providers share, as setters that work on any
+-- provider's config:
+--
+-- > withSystemTwo (anthropic & model "claude-sonnet-5-5" & effort Low)
+-- > withSystemOne (jev & model "jev-1.13.0")
+--
+-- Settings only one provider has are plain functions in that provider's module.
+module Agentic.Settings
+  ( HasModel (..)
+  , HasKey (..)
+  , HasEndpoint (..)
+  , HasTimeout (..)
+  , HasSystem (..)
+  , HasMaxTokens (..)
+  , HasEffort (..)
+  , Effort (..)
+  , (&)
+  ) where
+
+import Data.Function ((&))
+import Data.Text (Text)
+
+class HasModel c where
+  model :: Text -> c -> c
+
+-- | The API key or token. Providers default to their environment variable.
+class HasKey c where
+  key :: Text -> c -> c
+
+class HasEndpoint c where
+  endpoint :: String -> c -> c
+
+-- | How long to wait for a response, in seconds.
+class HasTimeout c where
+  timeout :: Int -> c -> c
+
+-- | A system prompt for every @draft@ in the runtime.
+class HasSystem c where
+  system :: Text -> c -> c
+
+class HasMaxTokens c where
+  maxTokens :: Int -> c -> c
+
+-- | How hard the model thinks. Each provider maps these to its own levels.
+class HasEffort c where
+  effort :: Effort -> c -> c
+
+data Effort = Low | Medium | High | XHigh | Max
+  deriving (Eq, Ord, Show, Enum, Bounded)
diff --git a/src/Agentic/Value.hs b/src/Agentic/Value.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/Value.hs
@@ -0,0 +1,50 @@
+-- | A small JSON-shaped value. The core owns this type so that it depends only on
+-- @base@ and @text@; provider packages convert to and from their wire libraries.
+module Agentic.Value
+  ( Value (..)
+  , renderJson
+  , lookupField
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Numeric (showHex)
+
+data Value
+  = Null
+  | Bool Bool
+  | Integer Integer
+  | Number Double
+  | String Text
+  | Array [Value]
+  | Object [(Text, Value)]
+    -- ^ Fields keep their order, so rendering is stable (useful for caching).
+  deriving (Eq, Ord, Show)
+
+-- | Render as compact JSON text.
+renderJson :: Value -> Text
+renderJson = \case
+  Null -> "null"
+  Bool True -> "true"
+  Bool False -> "false"
+  Integer n -> T.pack (show n)
+  Number d -> T.pack (show d)
+  String s -> quote s
+  Array vs -> "[" <> T.intercalate "," (map renderJson vs) <> "]"
+  Object kvs -> "{" <> T.intercalate "," [quote k <> ":" <> renderJson v | (k, v) <- kvs] <> "}"
+
+quote :: Text -> Text
+quote s = "\"" <> T.concatMap escape s <> "\""
+  where
+    escape = \case
+      '"' -> "\\\""
+      '\\' -> "\\\\"
+      '\n' -> "\\n"
+      '\r' -> "\\r"
+      '\t' -> "\\t"
+      c | c < ' ' -> T.pack ("\\u" <> pad (showHex (fromEnum c) ""))
+        | otherwise -> T.singleton c
+    pad h = replicate (4 - length h) '0' <> h
+
+lookupField :: Text -> [(Text, Value)] -> Maybe Value
+lookupField = lookup
diff --git a/src/Agentic/ViaLLM.hs b/src/Agentic/ViaLLM.hs
new file mode 100644
--- /dev/null
+++ b/src/Agentic/ViaLLM.hs
@@ -0,0 +1,69 @@
+-- | Letting an LLM stand in as System One, when there's no Jev.
+module Agentic.ViaLLM
+  ( viaLLM
+  ) where
+
+import Agentic.Core (Instruction (..))
+import Agentic.Questions
+import Agentic.Runtime
+import Agentic.Schema
+import Agentic.Value (Value (..), lookupField, renderJson)
+import Data.List (maximumBy)
+import Data.Ord (comparing)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+-- | Answer judgements with one LLM turn per request. The LLM gives a
+-- 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)
+      conversation =
+        Conversation
+          { path = []
+          , instruction = Instruction "Answer each question about the input. Give every probability as a number from 0 to 1."
+          , state = requestState request
+          , stateSchema = schemaOf SNull
+          , tools = []
+          , output = schemaOf (SObject [Field qid (questionSchema q) True | (qid, q) <- qs])
+          , history = []
+          }
+  turn <- askSystemTwo two conversation
+  case action turn 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"
+  where
+    ids = ["q" <> T.pack (show n) | n <- [0 :: Int ..]]
+    field' k kvs = maybe (Left ("missing " <> k)) Right (lookupField k kvs)
+
+questionSchema :: QuestionSpec -> Schema
+questionSchema = \case
+  AskYesNo q ->
+    documentSchema q (schemaOf (SObject [Field "probabilityYes" (documentSchema "The probability that the answer is yes" (schemaOf SNumber)) True]))
+  AskChoice q opts -> distribution (q <> " Give each option's probability; they should sum to 1.") opts
+  AskScore q levels -> distribution (q <> " The options are ordered levels, lowest first. Give each level's probability; they should sum to 1.") levels
+  where
+    distribution q opts =
+      documentSchema q (schemaOf (SObject [Field l (documentSchema (maybe l id d) (schemaOf SNumber)) True | (l, d) <- opts]))
+
+answer :: QuestionSpec -> Value -> Either Text Answer
+answer spec v = case (spec, v) of
+  (AskYesNo _, Object kvs) -> YesNoAnswer <$> (number =<< get "probabilityYes" kvs)
+  (AskChoice _ opts, Object kvs) -> do
+    ps <- traverse (\(l, _) -> (l,) <$> (number =<< get l kvs)) opts
+    let (best, p) = maximumBy (comparing snd) ps
+    pure (ChoiceAnswer best ps p)
+  (AskScore _ levels, Object kvs) -> do
+    ps <- traverse (\(l, _) -> number =<< get l kvs) levels
+    let weights = map probability ps
+        total = sum weights
+        pos = if total > 0 then sum (zipWith (*) [0 ..] weights) / total else 0
+    pure (ScoreAnswer pos (zip [0 ..] ps) (maximum ps))
+  (_, other) -> Left ("expected an object, got " <> renderJson other)
+  where
+    get k kvs = maybe (Left ("missing " <> k)) Right (lookupField k kvs)
+    number = \case
+      Number d -> Right (fromBasisPoints d)
+      Integer n -> Right (fromBasisPoints (fromInteger n))
+      other -> Left ("expected a probability, got " <> renderJson other)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,257 @@
+module Main (main) where
+
+import Agentic
+import Agentic.Scripted
+import Agentic.Schema (Field (..), Schema (..))
+import Data.IORef
+import Data.Text (Text)
+import qualified Data.Text as T
+import GHC.Generics (Generic)
+import Test.Hspec hiding (describe)
+import qualified Test.Hspec
+
+-- ---------------------------------------------------------------------------
+-- README types
+
+data Joke = Joke {genre :: Text, setup :: Text, punchline :: Text}
+  deriving (Generic, Show, Eq, Contract)
+
+data BetterJoke
+  = DadJoke {setup' :: Text, punchline' :: Text}
+  | OneLiner {line :: Text}
+  | KnockKnock {whosThere :: Text, punchline' :: Text}
+  deriving (Generic, Show, Eq, Contract)
+
+data Groan = Mild | Solid | Unbearable
+  deriving (Generic, Show, Eq)
+
+instance Options Groan where
+  options =
+    described
+      "How much the audience groans"
+      [ option Mild "A polite smile"
+      , option Solid "An audible groan"
+      , option Unbearable "People get up and leave"
+      ]
+
+deriving via Enumeration Groan instance Contract Groan
+
+newtype Rating = Rating Int
+  deriving (Show, Eq)
+
+instance Contract Rating where
+  contract = mapCodec Rating (\(Rating n) -> n) (between 1 10 contract)
+
+data Review = Review {funnyAnswer :: YesNo, groanAnswer :: Score Groan}
+  deriving (Show, Eq)
+
+described' :: Codec Joke
+described' =
+  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
+
+funny :: Questions YesNo
+funny = yesNo "Would a 10-year-old laugh at this joke?"
+
+groan :: Questions (Score Groan)
+groan = score "How much will the audience groan?"
+
+joke :: Joke
+joke = Joke "pun" "Why was the scarecrow promoted?" "He was outstanding in his field."
+
+-- ---------------------------------------------------------------------------
+-- Helpers
+
+-- | A runtime with a script for System Two and fixed answers for System One.
+testRuntime :: [Action] -> Probability -> IO (Runtime IO)
+testRuntime turns p = do
+  two <- scripted turns
+  pure runtime {systemOne = alwaysYes p, systemTwo = two}
+
+roundTrips :: (Eq a, Show a) => Codec a -> a -> Expectation
+roundTrips c a = decode c (encode c a) `shouldBe` Right a
+
+main :: IO ()
+main = hspec $ do
+  describe' "Contracts" $ do
+    it "round-trips a derived record" $
+      roundTrips contract joke
+
+    it "round-trips a derived sum as tagged objects" $ do
+      roundTrips contract (OneLiner "I'm on a seafood diet.")
+      encode contract (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
+
+    it "names derived schemas after their type" $
+      title (codecSchema (contract @Joke)) `shouldBe` Just "Joke"
+
+    it "keeps descriptions written in the codec" $
+      case shape (codecSchema described') of
+        SObject fs -> map (doc . fieldSchema) 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"]
+        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"
+
+  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))
+        `shouldBe` ["yesNo", "score 3"]
+
+    it "decodes answers back to typed values" $
+      decodeAnswers (Review <$> funny <*> groan) [YesNoAnswer 0.8, ScoreAnswer 1.2 [(1, 0.7), (2, 0.3)] 0.6]
+        `shouldBe` Right (Review (YesNo 0.8) (Score 1.2 [(Solid, 0.7), (Unbearable, 0.3)] 0.6))
+
+  describe' "interpret" $ do
+    it "drafts a typed value" $ do
+      rt <- testRuntime [respond joke] 1
+      interpret rt (draft @Joke "a joke please") () `shouldReturn` joke
+
+    it "sends a failed check back to the model and tries again" $ do
+      rt <- testRuntime [Respond (Integer 42), Respond (Integer 7)] 1
+      interpret rt (draft @Rating "rate this joke") joke `shouldReturn` Rating 7
+
+    it "runs a tool loop until the model responds" $ do
+      calls <- newIORef (0 :: Int)
+      let lookupGenre = tool @Text @Text "genre_of" "Look up a joke's genre" (act (\t -> modifyIORef calls (+ 1) >> pure ("pun about " <> t)))
+      rt <- testRuntime [callTools [("genre_of", String "scarecrows")], respond joke] 1
+      interpret rt (draftWith @Joke [lookupGenre] "a joke please") () `shouldReturn` joke
+      readIORef calls `shouldReturn` 1
+
+    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
+      _ <- interpret rt' (draft @Joke "a joke please") ()
+      results <- readIORef events
+      [r | ToolReturned _ r <- results] `shouldBe` [ToolFailed "there is no tool named nope"]
+
+    it "judges with System One" $ do
+      rt <- testRuntime [] 0.8
+      interpret rt (judge funny) joke `shouldReturn` YesNo 0.8
+
+    it "keeps items that pass" $ do
+      rt <- testRuntime [] 0.8
+      interpret rt (keep 0.7 funny) [joke, joke] `shouldReturn` [joke, joke]
+      interpret rt (keep 0.9 funny) [joke, joke] `shouldReturn` []
+
+    it "gates into branches" $ do
+      rt <- testRuntime [respond joke {genre = "kids"}] 0.5
+      let kidFriendly = gate 0.9 funny >>> (draft @Joke "rewrite this joke for a 10-year-old" ||| returnA)
+      interpret rt kidFriendly joke `shouldReturn` joke {genre = "kids"}
+
+    it "runs structure: fanout and each" $ do
+      rt <- testRuntime [respond joke, respond (Rating 3)] 1
+      interpret rt (draft @Joke "a joke" >>> (returnA &&& draft @Rating "rate it")) () `shouldReturn` (joke, Rating 3)
+      interpret rt (each (arr (* 2))) [1, 2, 3 :: Int] `shouldReturn` [2, 4, 6]
+      interpret rt (arr (+ 1) *** arr (* 2)) (1, 5 :: Int) `shouldReturn` (2 :: Int, 10)
+      interpret rt (repeatUntil (>= 10) (arr (* 2))) (3 :: Int) `shouldReturn` 12
+      interpret rt (repeatUntil (>= 10) (arr (* 2))) (50 :: Int) `shouldReturn` 50
+      interpret rt (second (arr show)) ('a', 7 :: Int) `shouldReturn` ('a', "7")
+      interpret rt (left (arr (+ 1))) (Left 1 :: Either Int Char) `shouldReturn` Left (2 :: Int)
+      interpret rt (left (arr (+ 1))) (Right 'x' :: Either Int Char) `shouldReturn` (Right 'x' :: Either Int Char)
+
+    it "fails clearly without a System One" $ do
+      interpret runtime (judge funny) joke `shouldThrow` (== NoSystemOne)
+
+  describe' "describe" $ do
+    it "draws the tree without running anything" $ do
+      let flow :: Agentic IO () [Joke]
+          flow =
+            draft @[Joke] "ten jokes please"
+              >>> keep 0.7 funny
+              >>> each (draftWith @Joke [tool @Text @Text "search" "Search" (act pure)] "polish this joke")
+      T.lines (renderTree (Agentic.describe flow))
+        `shouldBe` [ "draft @[Joke]  \"ten jokes please\""
+                   , "keep 0.7  each"
+                   , "└─ judge  yes/no \"Would a 10-year-old laugh at this joke?\"  (keeping its input)"
+                   , "each"
+                   , "└─ draft @Joke  \"polish this joke\""
+                   , "   └─ tool search  act"
+                   ]
+
+    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
+      T.lines (renderTree (Agentic.describe flow))
+        `shouldBe` ["both halves", "├─ first → draft @Rating  \"rate it\"", "└─ second → arr"]
+
+    it "draws first and second alike, and left and right alike" $ do
+      let d = draft @Rating "rate it"
+          tree :: Agentic IO i o -> [Text]
+          tree = T.lines . renderTree . Agentic.describe
+      tree (first d :: Agentic IO (Joke, Int) (Rating, Int)) `shouldBe` ["both halves", "├─ first → draft @Rating  \"rate it\"", "└─ second → pass"]
+      tree (second d :: Agentic IO (Int, Joke) (Int, Rating)) `shouldBe` ["both halves", "├─ first → pass", "└─ second → draft @Rating  \"rate it\""]
+      tree (left d :: Agentic IO (Either Joke Int) (Either Rating Int)) `shouldBe` ["branch", "├─ left → draft @Rating  \"rate it\"", "└─ right → pass"]
+
+    it "puts a description under the name in diagrams, not in the tree" $ do
+      let flow :: Agentic IO Joke Joke
+          flow = note "polish" "Tidy the wording" (draft @Joke "polish it" >>> note "check" "Make sure it's still a joke" (arr id))
+          d = Agentic.describe flow
+      any (T.isInfixOf "Tidy the wording") (T.lines (mermaid d)) `shouldBe` True
+      any (T.isInfixOf "act\\ncheck\\nMake sure") (T.lines (dot d)) `shouldBe` False
+      any (T.isInfixOf "arr\\ncheck\\nMake sure it's still a joke") (T.lines (dot d)) `shouldBe` True
+      any (T.isInfixOf "Tidy the wording") (T.lines (renderTree d)) `shouldBe` False
+
+    it "groups a parallel branch that's several steps in a row" $ do
+      let flow :: Agentic IO Joke (Joke, Rating)
+          flow = (draft @Joke "rewrite it" >>> draft @Joke "shorten it") &&& draft @Rating "rate it"
+      T.lines (renderTree (Agentic.describe flow))
+        `shouldBe` [ "together"
+                   , "├─ in order"
+                   , "│  ├─ draft @Joke  \"rewrite it\""
+                   , "│  └─ draft @Joke  \"shorten it\""
+                   , "└─ draft @Rating  \"rate it\""
+                   ]
+
+    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"
+      T.lines (renderTree (Agentic.describe flow))
+        `shouldBe` ["polish until it's for kids  repeatUntil", "└─ draft @Joke  \"make it more kid-friendly\""]
+
+    it "draws a fork that joins again in mermaid" $ do
+      let flow :: Agentic IO Joke (Joke, Rating)
+          flow = returnA &&& draft @Rating "rate it"
+          edges = filter (T.isInfixOf "-->") (T.lines (mermaid (Agentic.describe flow)))
+      edges `shouldBe` ["  input --> n0", "  input --> output", "  n0 --> 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"
+          out = mermaid (Agentic.describe flow)
+          dotOut = T.lines (dot (Agentic.describe flow))
+      filter (T.isInfixOf "->") dotOut `shouldBe` ["  input -> n2;", "  n2 -> output;"]
+      length (filter (T.isInfixOf "subgraph cluster_") dotOut) `shouldBe` 2
+      length (filter (T.isInfixOf "subgraph ") (T.lines out)) `shouldBe` 2
+
+    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")
+          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];"]
+
+    it "expands a tool that calls itself only once" $ do
+      let researcher :: Agentic IO Text Text
+          researcher = draftWith @Text [tool "research" "Research deeper" researcher] "research this"
+      T.lines (renderTree (Agentic.describe researcher))
+        `shouldBe` [ "draft @Text  \"research this\""
+                   , "└─ tool research  draft @Text  \"research this\""
+                   , "   └─ tool research  (see above)"
+                   ]
+  where
+    describe' = Test.Hspec.describe