packages feed

agentic-aeson (empty) → 0.2.0.0

raw patch · 5 files changed

+246/−0 lines, 5 filesdep +aesondep +agenticdep +base

Dependencies added: aeson, agentic, base, scientific, text, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog for agentic-aeson++## 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-aeson.cabal view
@@ -0,0 +1,38 @@+cabal-version:      3.0+name:               agentic-aeson+version:            0.2.0.0+synopsis:           Conversions between agentic's values and aeson, and strict JSON Schema+description:+  Shared by the agentic provider packages: converts the core's Value to and from aeson, and lowers contracts to the strict JSON Schema that providers' structured outputs accept, keeping field order and sharing repeated types through $defs.+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-aeson++library+  default-language: GHC2021+  default-extensions: LambdaCase OverloadedStrings+  ghc-options:      -Wall+  hs-source-dirs:   src+  exposed-modules:+    Agentic.Aeson+    Agentic.JsonSchema+  build-depends:+    , agentic          ==0.2.*+    , aeson       >=2.1 && <2.3+    , base        >=4.18 && <5+    , scientific       >=0.3 && <0.4+    , text             >=2.0 && <2.2+    , vector           >=0.12 && <0.14
+ src/Agentic/Aeson.hs view
@@ -0,0 +1,33 @@+-- | Conversions between the core's 'Agentic.Value.Value' and aeson's.+module Agentic.Aeson+  ( toAeson+  , fromAeson+  ) where++import qualified Agentic.Value as A+import qualified Data.Aeson as J+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+import Data.Scientific (floatingOrInteger)+import qualified Data.Vector as Vector++-- | The core's value as aeson's. Object keys keep no order once in aeson.+toAeson :: A.Value -> J.Value+toAeson = \case+  A.Null -> J.Null+  A.Bool b -> J.Bool b+  A.Integer n -> J.Number (fromInteger n)+  A.Number d -> J.Number (realToFrac d)+  A.String s -> J.String s+  A.Array vs -> J.Array (Vector.fromList (map toAeson vs))+  A.Object kvs -> J.Object (KeyMap.fromList [(Key.fromText k, toAeson v) | (k, v) <- kvs])++-- | Aeson's value as the core's. Whole numbers become integers.+fromAeson :: J.Value -> A.Value+fromAeson = \case+  J.Null -> A.Null+  J.Bool b -> A.Bool b+  J.Number n -> either A.Number A.Integer (floatingOrInteger n)+  J.String s -> A.String s+  J.Array vs -> A.Array (map fromAeson (Vector.toList vs))+  J.Object o -> A.Object [(Key.toText k, fromAeson v) | (k, v) <- KeyMap.toList o]
+ src/Agentic/JsonSchema.hs view
@@ -0,0 +1,145 @@+-- | Lowering the core's t'Schema' to the strict JSON Schema that providers'+-- structured outputs and strict tools accept.+--+-- The result is the core's 'Value', not aeson's, because order matters: a+-- model writes an object's fields in the order its schema lists them, and a+-- record's field order is part of its meaning (a setup comes before its+-- punchline). aeson would sort the keys. Render with 'renderJson'.+module Agentic.JsonSchema+  ( jsonSchema+  , objectSchema+  , schemaName+  , wrap+  , unwrap+  ) where++import Agentic.Schema+import Agentic.Value+import Data.Char (isAlphaNum)+import Data.List (nub)+import Data.Maybe (catMaybes)+import Data.Text (Text)+import qualified Data.Text as T++-- | A strict JSON Schema: every object lists all its fields as required and+-- forbids others; nullable fields may be null. Types are written out in full+-- wherever they appear; 'objectSchema' shares repeated ones.+jsonSchema :: Schema -> Value+jsonSchema = schemaWith []++-- | Like 'jsonSchema', but any schema named in @shared@ becomes a @$ref@ into+-- @$defs@.+schemaWith :: [Text] -> Schema -> Value+schemaWith shared s = case title s of+  Just t | t `elem` shared -> Object [("$ref", String ("#/$defs/" <> t))]+  _ -> definition shared s++-- | A schema written out, though the schemas inside it may still be references.+definition :: [Text] -> Schema -> Value+definition shared s = withDescription (body (shape s))+  where+    sub = schemaWith shared+    withDescription = \case+      Object kvs | Just d <- description -> Object (kvs <> [("description", String d)])+      v -> v+    description = case catMaybes [doc s] <> map (\c -> "Must be " <> c <> ".") (checks s) of+      [] -> Nothing+      ds -> Just (T.intercalate " " ds)+    body = \case+      SObject fs -> object (map (\f -> (fieldName f, sub (fieldSchema f))) fs)+      SSum vs -> Object [("anyOf", Array (map variant vs))]+      SEnum ls+        | all ((== Nothing) . snd) ls -> Object [typed "string", ("enum", Array (map (String . fst) ls))]+        | otherwise -> Object [("anyOf", Array [constant l d | (l, d) <- ls])]+      SArray inner -> Object [typed "array", ("items", sub inner)]+      SNullable inner -> Object [("anyOf", Array [sub inner, Object [typed "null"]])]+      SString format -> Object (typed "string" : maybe [] (\f -> [("format", String (formatName f))]) format)+      SInteger -> Object [typed "integer"]+      SNumber -> Object [typed "number"]+      SBool -> Object [typed "boolean"]+      SNull -> Object [typed "null"]+    variant v =+      let tagged = ("tag", Object [typed "string", ("const", String (variantTag v))])+          o = object (tagged : map (\f -> (fieldName f, sub (fieldSchema f))) (variantFields v))+       in case (o, variantDoc v) of+            (Object kvs, Just d) -> Object (kvs <> [("description", String d)])+            _ -> o+    constant l d = Object ([typed "string", ("const", String l)] <> maybe [] (\t -> [("description", String t)]) d)+    typed :: Text -> (Text, Value)+    typed t = ("type", String t)++object :: [(Text, Value)] -> Value+object fields =+  Object+    [ ("type", String "object")+    , ("properties", Object fields)+    , ("required", Array (map (String . fst) fields))+    , ("additionalProperties", Bool False)+    ]++formatName :: Format -> Text+formatName = \case+  DateTime -> "date-time"+  Date -> "date"+  Email -> "email"+  Uri -> "uri"+  Uuid -> "uuid"++-- | Does this schema need wrapping to be a top-level object?+wrap :: Schema -> Bool+wrap s = case shape s of+  SObject _ -> False+  _ -> True++-- | A top-level object schema: the schema itself if it's an object, or an+-- object with a single @value@ field holding it. A named type that appears more+-- than once, identically, is written once under @$defs@ and referenced.+--+-- TBD: Recursively defined schemas will hang here. A recursive type's derived+-- schema contains itself, so walking it never ends.+objectSchema :: Schema -> Value+objectSchema s = case root of+  Object kvs | not (null defs) -> Object (kvs <> [("$defs", Object defs)])+  other -> other+  where+    root+      | wrap s = object [("value", schemaWith shared s)]+      | otherwise = definition shared s+    shared = sharedNames s+    defs = [(t, definition shared d) | t <- shared, Just d <- [lookup t named']]+    named' = [(t, d) | d <- nested s, Just t <- [title d]]++-- | Names of the types inside a schema (not the schema itself) that appear more+-- than once and are identical everywhere they appear, in order of appearance.+sharedNames :: Schema -> [Text]+sharedNames s = [t | t <- nub names, uses t >= 2, length (nub [d | d <- inside, title d == Just t]) == 1]+  where+    inside = nested s+    names = catMaybes (map title inside)+    uses t = length (filter ((== Just t) . title) inside)++-- | Every schema nested inside this one, outermost first.+nested :: Schema -> [Schema]+nested s = concatMap (\c -> c : nested c) (children (shape s))+  where+    children = \case+      SObject fs -> map fieldSchema fs+      SSum vs -> concatMap (map fieldSchema . variantFields) vs+      SArray c -> [c]+      SNullable c -> [c]+      _ -> []++-- | A name for the schema, for providers that ask for one: the type's name with+-- anything but letters, digits, @_@ and @-@ dropped, or @output@.+schemaName :: Schema -> Text+schemaName s = case T.intercalate "_" (filter (not . T.null) (T.split (not . valid) (maybe "" id (title s)))) of+  "" -> "output"+  n -> T.take 64 n+  where+    valid c = isAlphaNum c || c == '_' || c == '-'++-- | Undo the wrapping 'objectSchema' adds, on a value from the provider.+unwrap :: Schema -> Value -> Value+unwrap s v+  | wrap s, Object kvs <- v, Just inner <- lookup "value" kvs = inner+  | otherwise = v