agentic-jev (empty) → 0.2.0.0
raw patch · 6 files changed
+367/−0 lines, 6 filesdep +aesondep +agenticdep +agentic-aeson
Dependencies added: aeson, agentic, agentic-aeson, agentic-io, agentic-jev, base, bytestring, hspec, http-client, http-client-tls, http-types, text
Files
- CHANGELOG.md +5/−0
- LICENSE +25/−0
- agentic-jev.cabal +72/−0
- src/Agentic/Jev.hs +146/−0
- test-live/Live.hs +58/−0
- test/Spec.hs +61/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for agentic-jev++## 0.2.0.0 - 2026-10-01++First release of the v2 design.
+ LICENSE view
@@ -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.
+ agentic-jev.cabal view
@@ -0,0 +1,72 @@+cabal-version: 3.0+name: agentic-jev+version: 0.2.0.0+synopsis: Jev (TypeSafe) as the System One provider for agentic+description:+ Answers agentic's judgements (yes/no, choice and score questions) with Jev, TypeSafe's System One model, which returns calibrated probabilities.+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-jev++common shared+ default-language: GHC2021+ default-extensions:+ DeriveAnyClass+ DuplicateRecordFields+ LambdaCase+ NoFieldSelectors+ OverloadedRecordDot+ OverloadedStrings+ ghc-options: -Wall++library+ import: shared+ hs-source-dirs: src+ exposed-modules: Agentic.Jev+ build-depends:+ , agentic ==0.2.*+ , aeson >=2.1 && <2.3+ , base >=4.18 && <5+ , bytestring >=0.11 && <0.13+ , http-client >=0.7 && <0.8+ , http-client-tls >=0.3 && <0.4+ , http-types >=0.12 && <0.13+ , text >=2.0 && <2.2+test-suite agentic-jev-test+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends:+ , agentic ==0.2.*+ , agentic-aeson ==0.2.*+ , agentic-jev ==0.2.*+ , aeson >=2.1 && <2.3+ , base >=4.18 && <5+ , hspec >=2.10 && <3+-- Calls the real Jev. Pending unless JEV_TOKEN is set (in the environment or .env).+test-suite agentic-jev-live+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test-live+ main-is: Live.hs+ build-depends:+ , agentic ==0.2.*+ , agentic-io ==0.2.*+ , agentic-jev ==0.2.*+ , base >=4.18 && <5+ , hspec >=2.10 && <3+ , text >=2.0 && <2.2
+ src/Agentic/Jev.hs view
@@ -0,0 +1,146 @@+-- | Jev (TypeSafe's System One model) as a runtime's System One.+--+-- > rt <- pure runtime >>= withSystemOne jev+-- > rt <- pure runtime >>= withSystemOne (jev & model "jev-1.13.0")+module Agentic.Jev+ ( Jev (..)+ , jev+ , JevError (..)+ -- * Wire format+ , requestBody+ , decodeResponse+ ) where++import qualified Agentic.Value as A+import Agentic.Questions+import Agentic.Runtime (ProvidesSystemOne (..), SystemOne (..))+import Agentic.Settings+import Control.Exception (Exception (..), throwIO)+import Data.Aeson ((.:))+import qualified Data.Aeson as J+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.Types as J+import qualified Data.ByteString.Lazy as LBS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Client as Http+import Network.HTTP.Client.TLS (newTlsManager)+import Network.HTTP.Types.Status (statusCode)+import System.Environment (lookupEnv)++-- | Jev's settings. Start from 'jev' and change them with the setters from+-- "Agentic.Settings": 'Agentic.Settings.model', 'Agentic.Settings.key',+-- 'Agentic.Settings.endpoint' and 'Agentic.Settings.timeout'.+data Jev = Jev+ { model :: Text+ , key :: Maybe Text+ -- ^ Defaults to the @JEV_TOKEN@ environment variable.+ , endpoint :: String+ , timeout :: Int+ -- ^ Seconds.+ }++jev :: Jev+jev =+ Jev+ { model = "jev-latest"+ , key = Nothing+ , endpoint = "https://api.typesafe.ai/v1/systemone"+ , timeout = 30+ }++instance HasModel Jev where model m c = c {model = m}+instance HasKey Jev where key k c = c {key = Just k}+instance HasEndpoint Jev where endpoint e c = c {endpoint = e}+instance HasTimeout Jev where timeout t c = c {timeout = t}++-- | What can go wrong talking to Jev. Thrown in IO.+data JevError+ = MissingToken+ | HttpError Int Text+ -- ^ Jev answered with a non-200 status, and this body.+ | UnexpectedResponse Text+ deriving (Show)++instance Exception JevError where+ displayException = \case+ MissingToken -> "Jev: no token. Set JEV_TOKEN, or use (jev & key ...)."+ HttpError status body -> "Jev rejected the request (HTTP " <> show status <> "): " <> T.unpack body+ UnexpectedResponse problem -> "Jev sent a response agentic can't read: " <> T.unpack problem++instance ProvidesSystemOne Jev where+ toSystemOne cfg = do+ token <- maybe (fmap T.pack <$> lookupEnv "JEV_TOKEN") (pure . Just) cfg.key+ token' <- maybe (throwIO MissingToken) pure token+ manager <- newTlsManager+ base <- Http.parseRequest cfg.endpoint+ pure $ SystemOne $ \request -> do+ let http =+ base+ { Http.method = "POST"+ , Http.requestHeaders =+ [ ("Authorization", "Bearer " <> T.encodeUtf8 token')+ , ("Content-Type", "application/json")+ ]+ , Http.requestBody = Http.RequestBodyBS (T.encodeUtf8 (A.renderJson (requestBody cfg.model request)))+ , Http.responseTimeout = Http.responseTimeoutMicro (cfg.timeout * 1000000)+ }+ response <- Http.httpLbs http manager+ let status = statusCode (Http.responseStatus response)+ body = Http.responseBody response+ if status /= 200+ then throwIO (HttpError status (T.decodeUtf8Lenient (LBS.toStrict body)))+ else case J.eitherDecode body of+ Left problem -> throwIO (UnexpectedResponse (T.pack problem))+ Right value -> either (throwIO . UnexpectedResponse) pure (decodeResponse request value)++-- | The request body: the state, and each question under an id (@q0@, @q1@, …).+-- It's the core's 'A.Value' so that options keep their order.+requestBody :: Text -> JudgeRequest -> A.Value+requestBody name request =+ A.Object+ [ ("model", A.String name)+ , ("state", requestState request)+ , ("questions", A.Object [(qid, question q) | (qid, q) <- ided (requestQuestions request)])+ ]+ where+ question = \case+ AskYesNo q -> A.Object [("type", A.String "noul"), ("instructions", A.String q)]+ AskChoice q opts ->+ A.Object+ [ ("type", A.String "choice")+ , ("instructions", A.String q)+ , ("criteria", A.Object [(l, maybe A.Null A.String d) | (l, d) <- opts])+ ]+ AskScore q levels ->+ A.Object+ [ ("type", A.String "score")+ , ("instructions", A.String q)+ , ("criteria", A.Array [A.String (maybe l id d) | (l, d) <- levels])+ ]++-- | Read Jev's answers back, in question order.+decodeResponse :: JudgeRequest -> J.Value -> Either Text [Answer]+decodeResponse request = either (Left . T.pack) Right . J.parseEither parse+ where+ parse = J.withObject "response" $ \response -> do+ answers <- response .: "answers"+ traverse (\(qid, q) -> answers .: Key.fromText qid >>= answer q) (ided (requestQuestions request))+ answer q = J.withObject "answer" $ \a -> case q of+ AskYesNo _ -> YesNoAnswer . fromBasisPoints <$> a .: "noul"+ AskChoice _ opts -> do+ ps <- a .: "probabilities"+ ChoiceAnswer+ <$> a .: "choice"+ <*> traverse (\(l, _) -> (l,) . fromBasisPoints <$> ps .: Key.fromText l) opts+ <*> (fromBasisPoints <$> a .: "confidence")+ AskScore _ levels -> do+ ps <- a .: "probabilities"+ ScoreAnswer+ <$> a .: "score"+ <*> traverse (\i -> (i,) . fromBasisPoints <$> ps .: Key.fromText (T.pack (show i))) [0 .. length levels - 1]+ <*> (fromBasisPoints <$> a .: "confidence")++ided :: [a] -> [(Text, a)]+ided = zip ["q" <> T.pack (show n) | n <- [0 :: Int ..]]
+ test-live/Live.hs view
@@ -0,0 +1,58 @@+module Main (main) where++import Agentic+import Agentic.IO.DotEnv (loadDotEnv)+import Agentic.Jev (jev)+import Data.Text (Text)+import GHC.Generics (Generic)+import System.Environment (lookupEnv)+import Test.Hspec hiding (describe)+import qualified Test.Hspec++data Joke = Joke {setup :: Text, punchline :: Text}+ deriving (Generic, Show, 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; most people didn't notice"+ , option Solid "An audible groan from most of the room"+ , option Unbearable "People get up and leave"+ ]++joke :: Joke+joke = Joke "Why was the scarecrow promoted?" "He was outstanding in his field."++main :: IO ()+main = do+ _ <- loadDotEnv+ token <- lookupEnv "JEV_TOKEN"+ hspec $ Test.Hspec.describe "Jev, live" $ case token of+ Nothing -> it "needs JEV_TOKEN" (pendingWith "set JEV_TOKEN in .env to run the live tests")+ Just _ -> do+ it "answers a yes/no, a choice and a score in one request" $ do+ rt <- pure runtime >>= withSystemOne jev+ (funny, reaction, groan) <-+ interpret rt+ ( judge $+ (,,)+ <$> yesNo "Would a 10-year-old laugh at this joke?"+ <*> choice @Groan "How will the audience react?"+ <*> score @Groan "How much will the audience groan?"+ )+ joke+ probability (yes funny) `shouldSatisfy` (\p -> p >= 0 && p <= 1)+ map fst (choiceProbabilities reaction) `shouldBe` [Mild, Solid, Unbearable]+ position groan `shouldSatisfy` (\p -> p >= 0 && p <= 2)++ it "filters with keep" $ do+ rt <- pure runtime >>= withSystemOne jev+ -- Plain text, not Joke: a record with "setup" and "punchline" fields+ -- tells Jev it's a joke before it reads a word.+ let texts = ["Why was the scarecrow promoted? He was outstanding in his field.", "The meeting is at 3pm in room 4." :: Text]+ kept <- interpret rt (keep 0.5 (yesNo "Is this text a joke?")) texts+ kept `shouldBe` take 1 texts
+ test/Spec.hs view
@@ -0,0 +1,61 @@+module Main (main) where++import Agentic+import Agentic.Aeson (toAeson)+import Agentic.Jev+import qualified Data.Aeson as J+import Data.Maybe (fromJust)+import GHC.Generics (Generic)+import Test.Hspec hiding (describe)+import qualified Test.Hspec++data Groan = Mild | Solid | Unbearable+ deriving (Generic, Show, Eq)++instance Options Groan where+ options = described "" [option Mild "A polite smile", option Solid "An audible groan", option Unbearable "People leave"]++request :: JudgeRequest+request =+ JudgeRequest+ (Object [("joke", String "Why was the scarecrow promoted?")])+ (specs ((,,) <$> yesNo "Is it funny?" <*> choice @Groan "Which reaction?" <*> score @Groan "How much groaning?"))+++main :: IO ()+main = hspec $ Test.Hspec.describe "Agentic.Jev" $ do+ it "builds Jev's request body" $+ toAeson (requestBody "jev-latest" request)+ `shouldBe` fromJust+ ( J.decode+ "{\"model\":\"jev-latest\",\+ \\"state\":{\"joke\":\"Why was the scarecrow promoted?\"},\+ \\"questions\":{\+ \\"q0\":{\"type\":\"noul\",\"instructions\":\"Is it funny?\"},\+ \\"q1\":{\"type\":\"choice\",\"instructions\":\"Which reaction?\",\+ \\"criteria\":{\"Mild\":\"A polite smile\",\"Solid\":\"An audible groan\",\"Unbearable\":\"People leave\"}},\+ \\"q2\":{\"type\":\"score\",\"instructions\":\"How much groaning?\",\+ \\"criteria\":[\"A polite smile\",\"An audible groan\",\"People leave\"]}}}"+ )++ it "decodes Jev's answers in question order" $+ decodeResponse+ request+ ( fromJust+ ( J.decode+ "{\"model\":\"jev-latest\",\"answers\":{\+ \\"q2\":{\"type\":\"score\",\"score\":1.25,\"legend\":{\"0\":\"A polite smile\",\"1\":\"An audible groan\",\"2\":\"People leave\"},\+ \\"probabilities\":{\"0\":0.1,\"1\":0.55,\"2\":0.35},\"confidence\":0.4},\+ \\"q0\":{\"type\":\"noul\",\"noul\":0.8132},\+ \\"q1\":{\"type\":\"choice\",\"choice\":\"Solid\",\"probabilities\":{\"Mild\":0.2,\"Solid\":0.7,\"Unbearable\":0.1},\"confidence\":0.5}},\+ \\"usage\":{\"input_tokens\":120,\"output_tokens\":3}}"+ )+ )+ `shouldBe` Right+ [ YesNoAnswer 0.8132+ , ChoiceAnswer "Solid" [("Mild", 0.2), ("Solid", 0.7), ("Unbearable", 0.1)] 0.5+ , ScoreAnswer 1.25 [(0, 0.1), (1, 0.55), (2, 0.35)] 0.4+ ]++ it "reports a response it can't read" $+ decodeResponse request (J.object []) `shouldSatisfy` either (const True) (const False)