@voxgig/sdkgen 3.5.1 → 3.7.0

package/project/.sdk/src/cmp/haskell/Test_haskell.ts

@@ -1,300 +0,0 @@
-import {
-  KIT,
-  getModelPath
-} from '@voxgig/apidef'
-
-import type {
-  ModelEntity
-} from '@voxgig/apidef'
-
-import { cmp, each, Folder, File, Content } from '@voxgig/sdkgen'
-
-import { hsVarName } from './utility_haskell'
-import { ReadmeExamplesTest } from './ReadmeExamplesTest_haskell'
-
-
-// test/SdkGenTests.hs — model-driven per-entity tests: an instance test, a
-// CRUD basic-flow test driven through the in-memory mock (test mode), and a
-// direct() call test against an injected system.fetch mock. Only ops the
-// entity actually defines are exercised.
-const Test = cmp(function Test(props: any) {
-  const { model } = props.ctx$
-  const { target } = props
-
-  const entity = getModelPath(model, `main.${KIT}.entity`)
-
-  Folder({ name: 'test' }, () => {
-
-    // Structural gate over the documented Haskell examples (emits
-    // test/TReadmeExamples.hs); wired into genTests below so it runs in the
-    // standard Runner.
-    ReadmeExamplesTest({ target })
-
-    File({ name: 'SdkGenTests.' + target.ext }, () => {
-
-      let calls = ''
-      let defs = ''
-
-      each(entity, (e: any) => {
-        const fn = hsVarName(e.name)
-        const ops = Object.keys(e.op || {})
-        const hasCreate = ops.includes('create')
-        const hasList = ops.includes('list')
-        const hasLoad = ops.includes('load')
-        const hasUpdate = ops.includes('update')
-        const hasRemove = ops.includes('remove')
-
-        // Pick a text field to mutate in update (first non-id field with a
-        // string value in the new-ref data, else "name").
-        let updField = 'name'
-        try {
-          const nf = e.fields || {}
-          const cand = Object.keys(nf).find((k) => k !== 'id' && !k.endsWith('$'))
-          if (cand) updField = cand
-        } catch (_e) { }
-
-        const instFn = `${fn}InstanceTest`
-        const basicFn = `${fn}BasicTest`
-        const directFn = `${fn}DirectTest`
-
-        calls += `  ${instFn} c\n`
-        calls += `  ${basicFn} c\n`
-        calls += `  ${directFn} c\n`
-
-        defs += `
-${instFn} :: Counters -> IO ()
-${instFn} c = runTest c "${e.name}.instance" $ do
-  sdk <- C.testSdk0
-  ent <- C.${fn} sdk VNoval
-  pure (eName ent == "${e.name}")
-
-${basicFn} :: Counters -> IO ()
-${basicFn} c = do
-  fixture <- loadFixture "${e.Name}"
-  existing <- getp fixture "existing"
-  opts <- jo [("entity", existing)]
-`
-        // Basic flow. Each op is an independent runTest.
-        if (hasList) {
-          defs += `  runTest c "${e.name}.list" $ do
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    em1 <- emptyMap; em2 <- emptyMap
-    lst <- eList ent em1 em2
-    -- \`list\` resolves to one ENTITY per record; the record is reached
-    -- through eDataGet. See AGENTS.md "Entity operations return ENTITIES".
-    ok <- mapM (\\en -> ismap <$> eDataGet en) lst
-    pure (all id ok)
-`
-        }
-        if (hasLoad) {
-          defs += `  runTest c "${e.name}.load" $ do
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    entmap <- getp existing "${e.name}"
-    ids <- keysof entmap
-    case ids of
-      [] -> pure True
-      (id0 : _) -> do
-        m <- jo [("id", VStr id0)]; ctrl <- emptyMap
-        loaded <- eLoad ent m ctrl
-        ld <- eDataGet loaded
-        lid <- getp ld "id"
-        pure (ismap ld && vstring lid == id0)
-`
-        }
-        if (hasCreate) {
-          defs += `  runTest c "${e.name}.create" $ do
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    d <- newRefData fixture "${e.name}"
-    ctrl <- emptyMap
-    created <- eCreate ent d ctrl
-    cd <- eDataGet created
-    cid <- getp cd "id"
-    pure (ismap cd && not (isNoval cid))
-`
-        }
-        if (hasCreate && hasUpdate) {
-          defs += `  runTest c "${e.name}.update" $ do
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    d <- newRefData fixture "${e.name}"
-    ctrl <- emptyMap
-    created <- eCreate ent d ctrl
-    cd <- eDataGet created
-    cid <- getp cd "id"
-    upd <- jo [("id", cid), ("${updField}", VStr "UpdatedMark")]
-    ctrl2 <- emptyMap
-    updated <- eUpdate ent upd ctrl2
-    ud <- eDataGet updated
-    uv <- getp ud "${updField}"
-    pure (ismap ud && vstring uv == "UpdatedMark")
-`
-        }
-        if (hasCreate && hasRemove) {
-          defs += `  runTest c "${e.name}.remove" $ do
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    d <- newRefData fixture "${e.name}"
-    ctrl <- emptyMap
-    created <- eCreate ent d ctrl
-    cd <- eDataGet created
-    cid <- getp cd "id"
-    rm <- jo [("id", cid)]; ctrl2 <- emptyMap
-    -- \`remove\` resolves to the entity, marked. It KEEPS the data it held.
-    removed <- eRemove ent rm ctrl2
-    gone <- readIORef (eDeleted removed)
-    rd <- eDataGet removed
-    rid <- getp rd "id"
-    pure (gone && vstring rid == vstring cid)
-`
-        }
-        // An op-less entity (no list/load/create — e.g. a bare path entity)
-        // appends no runTest, leaving the do-block ending on `opts <- jo [...]`
-        // (a bind), which is illegal as the final statement. Terminate it.
-        if (!hasList && !hasLoad && !hasCreate) {
-          defs += `  pure ()\n`
-        }
-
-        // Direct call test (via injected system.fetch mock).
-        defs += `
-${directFn} :: Counters -> IO ()
-${directFn} c = runTest c "${e.name}.direct" $ do
-  calls <- newIORef (0 :: Int)
-  let mock = VFunc (\\_ _ _ _ -> do
-        modifyIORef calls (+ 1)
-        d <- jo [("id", VStr "direct01")]
-        jo [("status", VNum 200), ("statusText", VStr "OK"), ("json", jsonThunk d)])
-  sys <- jo [("fetch", mock)]
-  opts <- jo [("base", VStr "http://localhost:8080"), ("system", sys)]
-  sdk <- C.newSdk opts
-  args <- jo [("path", VStr "/${e.name}/x"), ("method", VStr "GET")]
-  res <- F.direct sdk args
-  ok <- getp res "ok"
-  st <- getp res "status"
-  dat <- getp res "data"
-  did <- getp dat "id"
-  n <- readIORef calls
-  pure (isTrueV ok && toInt st == 200 && vstring did == "direct01" && n == 1)
-`
-
-        // PR review #4: entity eStream(action, args, callopts) runs the op
-        // through the full pipeline and returns a lazy list. Fallback (no
-        // streaming feature) yields the materialised items; with the streaming
-        // feature active it yields from the streaming iterator (chunkSize
-        // groups into batches). Needs a list op; seeds three records.
-        if (hasList) {
-          const streamFn = `${fn}StreamTest`
-          calls += `  ${streamFn} c\n`
-          defs += `
-${streamFn} :: Counters -> IO ()
-${streamFn} c = do
-  let mkSeed = do
-        r1 <- jo [("id", VStr "S1"), ("name", VStr "a")]
-        r2 <- jo [("id", VStr "S2"), ("name", VStr "b")]
-        r3 <- jo [("id", VStr "S3"), ("name", VStr "c")]
-        recs <- jo [("S1", r1), ("S2", r2), ("S3", r3)]
-        jo [("${e.name}", recs)]
-      hasStreaming = do
-        sdk0 <- C.testSdk0
-        fs <- getp (clConfig sdk0) "feature"
-        st <- getp fs "streaming"
-        pure (not (isNoval st))
-  runTest c "${e.name}.stream" $ do
-    seed <- mkSeed; opts <- jo [("entity", seed)]
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    em1 <- emptyMap
-    items <- eStream ent "list" em1 VNoval
-    pure (length items == 3 && (case items of (x : _) -> ismap x; [] -> False))
-  runTest c "${e.name}.stream_signal" $ do
-    seed <- mkSeed; opts <- jo [("entity", seed)]
-    sdk <- C.testSdk opts VNoval
-    ent <- C.${fn} sdk VNoval
-    em1 <- emptyMap
-    n <- newIORef (0 :: Int)
-    let sig = vfunc0 (do modifyIORef n (+ 1); v <- readIORef n; pure (VBool (v >= 2)))
-    co <- jo [("signal", sig)]
-    items <- eStream ent "list" em1 co
-    pure (length items == 1)
-  runTest c "${e.name}.stream_active" $ do
-    hs <- hasStreaming
-    if not hs then pure True else do
-      seed <- mkSeed; opts <- jo [("entity", seed)]
-      stg <- jo [("active", VBool True)]; strm <- jo [("streaming", stg)]; sopts <- jo [("feature", strm)]
-      sdk <- C.testSdk opts sopts
-      ent <- C.${fn} sdk VNoval
-      em1 <- emptyMap
-      items <- eStream ent "list" em1 VNoval
-      pure (length items == 3)
-  runTest c "${e.name}.stream_chunk" $ do
-    hs <- hasStreaming
-    if not hs then pure True else do
-      seed <- mkSeed; opts <- jo [("entity", seed)]
-      stg <- jo [("active", VBool True), ("chunkSize", VNum 2)]; strm <- jo [("streaming", stg)]; sopts <- jo [("feature", strm)]
-      sdk <- C.testSdk opts sopts
-      ent <- C.${fn} sdk VNoval
-      em1 <- emptyMap
-      batches <- eStream ent "list" em1 VNoval
-      pure (length batches == 2)
-`
-        }
-      })
-
-      Content(`-- Generated model-driven entity + direct tests.
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module SdkGenTests (genTests) where
-
-import Control.Exception (SomeException, try)
-import Data.IORef
-
-import VoxgigStruct (Value (..), emptyMap, keysof, ismap, islist, isNoval, clone)
-import SdkTypes
-import SdkHelpers
-import qualified SdkFeatures as F
-import qualified SdkClient as C
-import qualified TReadmeExamples
-import Testutil
-import SdkJson (jsonRead)
-
--- Load an entity fixture (../.sdk/test/entity/<name>/<Name>TestData.json).
-loadFixture :: String -> IO Value
-loadFixture entName = do
-  -- The fixture DIRECTORY is the snake_case entity name (create_result), so a
-  -- plain lowercase of the CamelCase entName (createresult) misses the
-  -- underscores for multi-word entities. Convert CamelCase -> snake_case.
-  let lname = camelToSnake entName
-  raw <- readFile ("../.sdk/test/entity/" ++ lname ++ "/" ++ entName ++ "TestData.json")
-  jsonRead raw
-  where
-    toLowerCh ch = if ch >= 'A' && ch <= 'Z' then toEnum (fromEnum ch + 32) else ch
-    camelToSnake [] = []
-    camelToSnake (c0 : rest) = toLowerCh c0 : go rest
-    go [] = []
-    go (c : cs)
-      | c >= 'A' && c <= 'Z' = '_' : toLowerCh c : go cs
-      | otherwise = c : go cs
-
--- The first new-ref data map for an entity (fixture.new.<entity>.<ref0>).
-newRefData :: Value -> String -> IO Value
-newRefData fixture entName = do
-  newEnts <- getpathS fixture ("new." ++ entName)
-  refs <- keysof newEnts
-  case refs of
-    [] -> emptyMap
-    (r0 : _) -> do d <- getp newEnts r0; clone d
-
-genTests :: Counters -> IO ()
-genTests c = do
-  TReadmeExamples.tests c
-${calls}${defs}`)
-    })
-  })
-})
-
-
-export {
-  Test
-}

package/project/.sdk/src/cmp/haskell/tsconfig.json

@@ -1,15 +0,0 @@
-{
-  "compilerOptions": {
-    "esModuleInterop": true,
-    "module": "nodenext",
-    "noEmitOnError": true,
-    "outDir":"../dist",
-    "rootDir":".",
-    "resolveJsonModule": true,
-    "sourceMap": true,
-    "strict": true,
-    "target": "es2022",
-    "declaration": true,
-    "declarationDir": "../dist"
-  }
-}

package/project/.sdk/src/cmp/haskell/utility_haskell.ts

@@ -1,166 +0,0 @@
-import * as Path from 'node:path'
-
-import {
-  clone,
-  walk,
-} from '@voxgig/struct'
-
-
-function projectPath(suffix?: string): string {
-  return Path.normalize(Path.join(__dirname, '../../..', suffix ?? ''))
-}
-
-
-// Haskell reserved words that cannot be used as identifiers.
-const HS_RESERVED = new Set<string>([
-  'case', 'class', 'data', 'default', 'deriving', 'do', 'else', 'foreign',
-  'if', 'import', 'in', 'infix', 'infixl', 'infixr', 'instance', 'let',
-  'module', 'newtype', 'of', 'then', 'type', 'where', 'as', 'hiding',
-  'qualified',
-])
-
-
-// A collision-free lower-camel Haskell identifier for a model name.
-function hsVarName(name: string): string {
-  let s = String(name).replace(/[^a-zA-Z0-9_]/g, '_')
-  if (s.length === 0) {
-    s = 'x'
-  }
-  // Identifiers must start with a lowercase letter.
-  s = s.charAt(0).toLowerCase() + s.slice(1)
-  if (!/^[a-z_]/.test(s)) {
-    s = 'e_' + s
-  }
-  return HS_RESERVED.has(s) ? s + '_' : s
-}
-
-
-// A Haskell string literal (7-bit safe: non-printable / non-ASCII use the
-// decimal numeric escape with a `\&` separator so digits never merge).
-function hsString(s: string): string {
-  let out = '"'
-  for (const ch of String(s)) {
-    const code = ch.codePointAt(0) as number
-    if (ch === '"') out += '\\"'
-    else if (ch === '\\') out += '\\\\'
-    else if (ch === '\n') out += '\\n'
-    else if (ch === '\t') out += '\\t'
-    else if (ch === '\r') out += '\\r'
-    else if (code >= 32 && code < 127) out += ch
-    else out += '\\' + code + '\\&'
-  }
-  return out + '"'
-}
-
-
-// Render a JSON-shaped value as a Haskell `CV` literal (the generated
-// SdkConfig realises it with buildCV). Empty map/list render as
-// (CVMap []) / (CVList []) — valid for 0, 1 or N entries (N-feature-safe).
-//
-// KEY ORDER IS INSERTION ORDER, not sorted. struct's Haskell `Value` holds a
-// map as an ORDERED assoc list, so key order is observable — it survives into
-// keysof, iteration and stringify. This used to sort, which was fine while
-// this was the only representation, but above the size threshold the same
-// config arrives via jsonRead in the JSON text's order. Sorting here would
-// have made the two representations describe the same config in a different
-// order, which is exactly what rung L1 promises cannot happen.
-//
-// Insertion order is still byte-stable: every nested level of the config comes
-// from `each`, which iterates sorted, and the two levels built by hand
-// (the root, and `options`) have a fixed order every target's literal follows.
-function formatHsValue(val: any): string {
-  if (val === null || val === undefined) {
-    return 'CVNull'
-  }
-  if (typeof val === 'string') {
-    return '(CVStr ' + hsString(val) + ')'
-  }
-  if (typeof val === 'number') {
-    return '(CVNum (' + (Number.isFinite(val) ? String(val) : '0') + '))'
-  }
-  if (typeof val === 'boolean') {
-    return '(CVBool ' + (val ? 'True' : 'False') + ')'
-  }
-  if (Array.isArray(val)) {
-    const items = val.map((v) => formatHsValue(v)).join(', ')
-    return '(CVList [' + items + '])'
-  }
-  if (typeof val === 'object') {
-    const items = Object.keys(val)
-      .map((k) => '(' + hsString(k) + ', ' + formatHsValue(val[k]) + ')')
-      .join(', ')
-    return '(CVMap [' + items + '])'
-  }
-  return 'CVNull'
-}
-
-
-// Remove `$`-suffixed model annotation keys.
-// Emission-time normalisation of a model subtree (L0).
-//
-// Always drops jostraca's iteration metadata (`$`-suffixed keys: index$,
-// key$, val$). With `dropDefaults`, also drops keys whose value IS the
-// default the runtime already assumes when the key is absent, which is pure
-// payload — see CONFIG_DEFAULT.
-//
-// Rebuilds the tree rather than mutating during a walk. The previous
-// implementation walked a clone calling `delete p[k]`, but walk() assigns its
-// callback's result back over the child (`setprop(out, ckey, walk(...))`), so
-// the delete was undone on the way out and the helper silently did nothing.
-// Returning `undefined` from the callback does not fix it either: setprop
-// stores undefined rather than removing the key, which then emits as a null.
-//
-// `dropDefaults` is opt-in and must be passed ONLY for the entity subtree.
-// `active` means something different in feature config, where absent reads as
-// INACTIVE (see feature_init) — dropping `active: true` there would silently
-// disable the feature.
-// jostraca's iteration metadata, injected by each()/names() while it walks the
-// model. Listed explicitly rather than matched by trailing-dollar suffix: a
-// trailing dollar is not exclusive to jostraca -- Seneca uses entity$ as real
-// data -- so a blanket suffix match can silently drop a legitimate API field.
-const MODEL_META = ['index$', 'key$', 'val$']
-
-// Keys whose value IS the default the runtime already assumes when the key is
-// absent, so emitting them is pure payload.
-const CONFIG_DEFAULT: Record<string, any> = {
-  active: true,
-  req: false,
-  reqd: false,
-}
-
-// Subtrees carrying user payload rather than schema. An active:true inside an
-// OpenAPI example is DATA, not a default, so default-pruning stops at these
-// keys and everything below them is passed through untouched.
-const PAYLOAD_KEYS = ['default', 'example', 'examples']
-
-function clean(o: any, dropDefaults?: boolean): any {
-  const prune = (node: any, defaults: boolean): any => {
-    if (Array.isArray(node)) {
-      return node.map((n: any) => prune(n, defaults))
-    }
-    if (null != node && 'object' === typeof node) {
-      const out: any = {}
-      for (const k of Object.keys(node)) {
-        if (MODEL_META.includes(k)) {
-          continue
-        }
-        if (defaults && k in CONFIG_DEFAULT && CONFIG_DEFAULT[k] === node[k]) {
-          continue
-        }
-        out[k] = prune(node[k], defaults && !PAYLOAD_KEYS.includes(k))
-      }
-      return out
-    }
-    return node
-  }
-  return prune(o, true === dropDefaults)
-}
-
-
-export {
-  clean,
-  formatHsValue,
-  hsString,
-  hsVarName,
-  projectPath,
-}

package/project/.sdk/tm/haskell/LICENSE

@@ -1,21 +0,0 @@
-MIT License
-
-Copyright (c) 2025 voxgig
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.

package/project/.sdk/tm/haskell/Makefile

@@ -1,22 +0,0 @@
-# ProjectName SDK — Haskell build/test.
-# Requires GHC (`ghc`) on PATH. No third-party dependencies (only the GHC
-# boot libraries: base, containers, array, time). The vendored voxgig struct
-# port lives under src/ (VoxgigStruct.hs + Vregex.hs).
-
-.PHONY: test build clean
-
-BUILDDIR := .hsbuild
-
-# Build and run the full SDK test suite + vendored struct corpus. The runner
-# reads the shared spec at ../.sdk/test/test.json (run from this directory).
-test:
-	@mkdir -p $(BUILDDIR)
-	ghc -O0 -isrc -itest -outputdir $(BUILDDIR) -o $(BUILDDIR)/runner test/Runner.hs
-	$(BUILDDIR)/runner
-
-# Type-check only (a clean compile = pass).
-build:
-	ghc -fno-code -isrc -itest test/Runner.hs
-
-clean:
-	rm -rf $(BUILDDIR) src/*.hi src/*.o test/*.hi test/*.o

package/project/.sdk/tm/haskell/VERSION

@@ -1 +0,0 @@
-PROJECTVERSION