@voxgig/sdkgen-langpack 0.0.1

package/.sdk/src/cmp/haskell/Main_haskell.ts

@@ -0,0 +1,123 @@
+import {
+  cmp, each,
+  File, Content, Copy, Folder,
+} from '@voxgig/sdkgen'
+
+
+import type {
+  ModelEntity
+} from '@voxgig/apidef'
+
+
+import {
+  KIT,
+  getModelPath
+} from '@voxgig/apidef'
+
+
+import { Package } from './Package_haskell'
+import { Config } from './Config_haskell'
+import { Gitignore } from './Gitignore_haskell'
+import { hsVarName } from './utility_haskell'
+
+
+const Main = cmp(async function Main(props: any) {
+
+  const { target } = props
+  const { model } = props.ctx$
+
+  const entity: ModelEntity = getModelPath(model, `main.${KIT}.entity`)
+
+  Package({ target })
+
+  Gitignore({})
+
+  // Copy tm/haskell verbatim: the runtime under src/ (VoxgigStruct, Vregex,
+  // SdkTypes, SdkHelpers, SdkRuntime, SdkFeatures), the test suite under
+  // test/, and Makefile/LICENSE/VERSION. The per-feature custom-source
+  // scaffold under src/feature is excluded (this target does not use it —
+  // entities are generic and config-driven, so there are no per-entity or
+  // per-feature generated modules). Placeholder substitution applies.
+  Copy({
+    from: 'tm/' + target.name,
+    exclude: [/src\/feature\//],
+    replace: {
+      ...props.ctx$.stdrep,
+    }
+  })
+
+  // Generated modules under src/: the API config + feature factory, and the
+  // public client (SDK constructors + entity accessors).
+  Folder({ name: 'src' }, () => {
+
+    Config({ target })
+
+    File({ name: 'SdkClient.' + target.ext }, () => {
+
+      let accessors = ''
+      let exports = ''
+      each(entity, (e: any) => {
+        const fn = hsVarName(e.name)
+        exports += `  , ${fn}\n`
+        accessors += `-- | The ${e.Name} entity bound to this client.
+${fn} :: Client -> Value -> IO Entity
+${fn} client entopts = F.makeEntity client "${e.name}" entopts
+
+`
+      })
+
+      Content(`-- ${model.const.Name} SDK public client (generated by @voxgig/sdkgen).
+--
+-- SDK constructors (newSdk / testSdk) and one accessor per entity. Entities
+-- are generic — every accessor calls the config-driven F.makeEntity, so the
+-- operation pipeline is identical for every entity and every API.
+
+module SdkClient
+  ( module SdkTypes
+  , newSdk
+  , newSdk0
+  , testSdk
+  , testSdk0
+${exports}  ) where
+
+import Data.IORef (readIORef)
+
+import VoxgigStruct (Value (..))
+import SdkTypes
+import SdkConfig (makeConfig, makeFeature)
+import qualified SdkFeatures as F
+
+-- | Construct a live SDK client from an options map (Noval for defaults).
+newSdk :: Value -> IO Client
+newSdk options = do
+  cfg <- makeConfig
+  F.makeClientBase cfg makeFeature options
+
+-- | No-argument convenience constructor.
+newSdk0 :: IO Client
+newSdk0 = newSdk VNoval
+
+-- | Construct a test-mode SDK: testSdk testopts sdkopts.
+testSdk :: Value -> Value -> IO Client
+testSdk testopts sdkopts = do
+  cfg <- makeConfig
+  F.sdkTest cfg makeFeature testopts sdkopts
+
+-- | No-argument convenience test constructor.
+testSdk0 :: IO Client
+testSdk0 = testSdk VNoval VNoval
+
+-- | The active client mode ("live" or "test").
+clientMode :: Client -> IO String
+clientMode = readIORef . clMode
+
+${accessors}`)
+    })
+  })
+
+})
+
+
+export {
+  Main
+}

package/.sdk/src/cmp/haskell/Package_haskell.ts

@@ -0,0 +1,60 @@
+import {
+  Content,
+  File,
+  cmp,
+  packageVersion,
+} from '@voxgig/sdkgen'
+
+
+import type {
+  Model,
+} from '@voxgig/apidef'
+
+
+function pkgName(model: any): string {
+  const org = (model.origin || 'voxgig-sdk').replace(/-sdk$/, '')
+  return `${org}-${model.name}-sdk`.toLowerCase().replace(/[^a-z0-9-]/g, '-')
+}
+
+
+// The cabal package file (for Hackage publication). The offline test build
+// uses the Makefile (stock ghc, boot libraries only: base + containers +
+// array + time), so no cabal solve is required to run the suite.
+const Package = cmp(async function Package(props: any) {
+  const ctx$ = props.ctx$
+  const target = props.target
+
+  const model: Model = ctx$.model
+
+  File({ name: pkgName(model) + '.cabal' }, () => {
+    Content(`cabal-version:      2.4
+name:               ${pkgName(model)}
+version:            ${packageVersion(model, target.name)}
+synopsis:           ${model.const.Name} SDK for Haskell (generated by @voxgig/sdkgen)
+license:            MIT
+build-type:         Simple
+
+library
+    default-language: Haskell2010
+    hs-source-dirs:   src
+    exposed-modules:  VoxgigStruct
+                      Vregex
+                      SdkJson
+                      SdkTypes
+                      SdkHelpers
+                      SdkRuntime
+                      SdkFeatures
+                      SdkConfig
+                      SdkClient
+    build-depends:    base >=4.14 && <5
+                    , containers >=0.6 && <0.8
+                    , array >=0.5 && <0.6
+                    , time >=1.9 && <1.15
+`)
+  })
+})
+
+
+export {
+  Package
+}

package/.sdk/src/cmp/haskell/ReadmeEntity_haskell.ts

@@ -0,0 +1,186 @@
+
+import { cmp, each, Content, canonKey, entityIdField, opRequestShape } from '@voxgig/sdkgen'
+
+import {
+  KIT,
+  getModelPath,
+} from '@voxgig/apidef'
+
+import { hsVarName } from './utility_haskell'
+
+
+// A type-correct Haskell `Value` literal for a field's canonical type.
+function hsLit(type: any, placeholder: string = 'example'): string {
+  const k = canonKey(type)
+  if ('INTEGER' === k || 'NUMBER' === k) return 'VNum 1'
+  if ('BOOLEAN' === k) return 'VBool True'
+  if ('ARRAY' === k || 'OBJECT' === k) return 'VNoval'
+  return `VStr "${placeholder}"`
+}
+
+
+// A readable Haskell type name for a field's canonical type. The runtime
+// carries every field as a dynamic `Value`; this documents the logical type.
+function hsType(type: any): string {
+  const k = canonKey(type)
+  if ('STRING' === k) return 'String'
+  if ('INTEGER' === k) return 'Int'
+  if ('NUMBER' === k) return 'Double'
+  if ('BOOLEAN' === k) return 'Bool'
+  if ('ARRAY' === k) return '[Value]'
+  return 'Value'
+}
+
+
+const OP_DESC: Record<string, { method: string, desc: string }> = {
+  load:   { method: 'eLoad ent match ctrl',   desc: 'Load a single entity by match criteria. Resolves to the entity.' },
+  list:   { method: 'eList ent match ctrl',   desc: 'List entities, optionally matching the given criteria. Resolves to one entity per record.' },
+  create: { method: 'eCreate ent data ctrl',  desc: 'Create a new entity with the given data. Resolves to the entity.' },
+  update: { method: 'eUpdate ent data ctrl',  desc: 'Update an existing entity. Resolves to the entity.' },
+  remove: { method: 'eRemove ent match ctrl', desc: 'Remove the matching entity. Resolves to the entity, marked deleted.' },
+}
+
+
+const ReadmeEntity = cmp(function ReadmeEntity(props: any) {
+  const { target } = props
+  const { model } = props.ctx$
+
+  const entity = getModelPath(model, `main.${KIT}.entity`)
+
+  const publishedEntities = each(entity)
+    .filter((entity: any) => entity.active !== false)
+
+  if (0 === publishedEntities.length) {
+    return
+  }
+
+  Content(`
+
+## Entities
+
+`)
+
+  publishedEntities.map((entity: any) => {
+    const opnames = Object.keys(entity.op || {})
+    const fields = entity.fields || []
+    const idF = entityIdField(entity)
+    const eFn = hsVarName(entity.name)
+
+    Content(`
+### ${entity.Name}
+
+`)
+
+    if (entity.short) {
+      Content(`${entity.short}
+
+`)
+    }
+
+    Content(`Create an instance: \`${eFn} <- Sdk.${eFn} sdk VNoval\`
+
+`)
+
+    if (opnames.length > 0) {
+      Content(`#### Operations
+
+| Method | Description |
+| --- | --- |
+`)
+      opnames.map((opname: string) => {
+        const info = OP_DESC[opname]
+        if (info) {
+          Content(`| \`${info.method}\` | ${info.desc} |
+`)
+        }
+      })
+
+      Content(`
+`)
+    }
+
+    if (fields.length > 0) {
+      Content(`#### Fields
+
+| Field | Type | Description |
+| --- | --- | --- |
+`)
+
+      each(fields, (field: any) => {
+        const desc = field.short || ''
+        Content(`| \`${field.name}\` | \`${hsType(field.type)}\` | ${desc} |
+`)
+      })
+
+      Content(`
+`)
+    }
+
+    if (opnames.includes('load')) {
+      const loadItems = opRequestShape(entity, 'load').items
+        .filter((it: any) => !it.optional || it.name === idF)
+        .sort((a: any, b: any) =>
+          (a.name === idF ? 0 : 1) - (b.name === idF ? 0 : 1))
+      const loadArg = 0 < loadItems.length
+        ? `[${loadItems.map((it: any) =>
+          `("${it.name}", ${hsLit(it.type,
+            it.name === idF ? entity.name + '_id' : it.name)})`).join(', ')}]`
+        : '[]'
+      Content(`#### Example: Load
+
+\`\`\`haskell
+  ent <- Sdk.${eFn} sdk VNoval
+  match <- jo ${loadArg}
+  ctrl <- emptyMap
+  ${eFn} <- Sdk.eLoad ent match ctrl
+  -- The op resolves to the ENTITY; the record is inside it.
+  ${eFn}Data <- Sdk.eDataGet ${eFn}
+\`\`\`
+
+`)
+    }
+
+    if (opnames.includes('list')) {
+      Content(`#### Example: List
+
+\`\`\`haskell
+  ent <- Sdk.${eFn} sdk VNoval
+  match <- emptyMap
+  ctrl <- emptyMap
+  -- One ENTITY per record.
+  ${eFn}s <- Sdk.eList ent match ctrl
+  ${eFn}Datas <- mapM Sdk.eDataGet ${eFn}s
+\`\`\`
+
+`)
+    }
+
+    if (opnames.includes('create')) {
+      const createItems = opRequestShape(entity, 'create').items
+        .filter((it: any) => !it.optional)
+      Content(`#### Example: Create
+
+\`\`\`haskell
+  ent <- Sdk.${eFn} sdk VNoval
+  d <- jo
+    [`)
+      createItems.map((it: any, i: number) => {
+        const bracket = 0 === i ? ' ' : ', '
+        Content(`${bracket}("${it.name}", ${hsLit(it.type, 'example_' + it.name)})   -- ${hsType(it.type)}
+    `)
+      })
+      Content(`]
+  ctrl <- emptyMap
+  ${eFn} <- Sdk.eCreate ent d ctrl
+  ${eFn}Data <- Sdk.eDataGet ${eFn}
+\`\`\`
+
+`)
+    }
+  })
+})
+
+
+export {
+  ReadmeEntity
+}

package/.sdk/src/cmp/haskell/ReadmeExamplesTest_haskell.ts

@@ -0,0 +1,135 @@
+
+import { cmp, File, Content } from '@voxgig/sdkgen'
+
+
+// Emits test/TReadmeExamples.hs — a STRUCTURAL gate over every fenced
+// Haskell code block in the three docs that ship Haskell examples:
+//   - the root README.md (top-level, multi-language quick start)
+//   - the per-language haskell/README.md
+//   - the per-language haskell/REFERENCE.md
+//
+// DESIGN NOTE vs the Python gate (ReadmeExamplesTest_py.ts): the Python
+// version parses AND executes every block in a seeded test-mode subprocess.
+// A faithful Haskell port would compile every snippet against the generated
+// SDK — a throwaway module per block plus a GHC invocation — a large,
+// environment-sensitive harness that cannot be authored safely without a build
+// to validate it. This gate instead validates that every documented Haskell
+// block is PRESENT, non-empty, and STRUCTURALLY well-formed (balanced
+// delimiters). Missing docs are tolerated (a run may generate a subset of
+// phases), and no blocks found records no failures — so this never breaks the
+// shared runner. Upgrading it to a true compile gate is left as a follow-up.
+//
+// The emitted module exposes `tests :: Counters -> IO ()`; the generated
+// SdkGenTests calls it, so it runs inside the standard Runner. The triple
+// backtick fence marker is built from its char code (toEnum 96) so this
+// component's Haskell source needs no backtick/backslash gymnastics.
+const ReadmeExamplesTest = cmp(function ReadmeExamplesTest(props: any) {
+  const { target, ctx$: { model } } = props
+
+  const Name = model.const.Name
+
+  File({ name: 'TReadmeExamples.' + target.ext }, () => {
+    Content(`-- ${Name} SDK — documentation Haskell-examples structural gate.
+--
+-- Validates that every fenced Haskell code block in the SDK docs (the root
+-- README.md, the per-language README.md, and REFERENCE.md) is present,
+-- non-empty, and has balanced delimiters. Missing docs are tolerated (a run
+-- may generate a subset of phases), so this gate never breaks the shared
+-- runner. See ReadmeExamplesTest_haskell for why this is a structural gate
+-- rather than a full compile harness. Generated by @voxgig/sdkgen.
+
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TReadmeExamples (tests) where
+
+import Control.Exception (SomeException, evaluate, try)
+import Control.Monad (forM_)
+
+import Testutil (Counters, runTest)
+
+
+-- True for the whitespace characters we trim: space, tab, carriage return.
+isWs :: Char -> Bool
+isWs ch = let n = fromEnum ch in n == 32 || n == 9 || n == 13
+
+
+-- Trim leading/trailing whitespace from a line.
+trimWs :: String -> String
+trimWs = f . f
+  where f = reverse . dropWhile isWs
+
+
+-- Read a doc file, tolerating absence (returns "" when missing/unreadable).
+readDoc :: FilePath -> IO String
+readDoc path = do
+  r <- try (do s <- readFile path; _ <- evaluate (length s); pure s)
+         :: IO (Either SomeException String)
+  pure (either (const "") id r)
+
+
+-- Extract the body of every fenced Haskell block from markdown. Returns
+-- (blocks, allClosed) where allClosed is False when a fence was opened but
+-- never closed before EOF — a malformed doc that must fail rather than pass
+-- silently on the unterminated block. The fence marker (three backticks) is
+-- built from its char code so this source stays backtick-free.
+haskellBlocks :: String -> ([String], Bool)
+haskellBlocks src = go (lines src)
+  where
+    fence3 = replicate 3 (toEnum 96 :: Char)
+    fenceHs = fence3 ++ "haskell"
+    go [] = ([], True)
+    go (l : ls)
+      | trimWs l == fenceHs =
+          case break (\\x -> trimWs x == fence3) ls of
+            (blk, [])       -> ([unlines blk], False)
+            (blk, _ : rest) -> let (bs, ok) = go rest in (unlines blk : bs, ok)
+      | otherwise = go ls
+
+
+-- Balanced (), [], {} outside of double-quoted string literals, with each
+-- closer matching the most-recent opener via a stack (so "([)]" is rejected,
+-- not merely counted). The generated snippets never embed an escaped quote
+-- inside a string.
+balanced :: String -> Bool
+balanced = go False []
+  where
+    go inStr stack [] = not inStr && null stack
+    go inStr stack (c : cs)
+      | c == '"'                          = go (not inStr) stack cs
+      | inStr                             = go inStr stack cs
+      | c == '('                          = go inStr (')' : stack) cs
+      | c == '['                          = go inStr (']' : stack) cs
+      | c == '{'                          = go inStr ('}' : stack) cs
+      | c == ')' || c == ']' || c == '}'  =
+          case stack of
+            (top : rest) | top == c -> go inStr rest cs
+            _                        -> False
+      | otherwise                         = go inStr stack cs
+
+
+-- The three documents held to the gate, tagged by human label.
+docs :: [(String, FilePath)]
+docs =
+  [ ("root README", "../README.md")
+  , ("${target.name} README", "README.md")
+  , ("${target.name} REFERENCE", "REFERENCE.md")
+  ]
+
+
+tests :: Counters -> IO ()
+tests c =
+  forM_ docs (\\(label, path) -> do
+    src <- readDoc path
+    let (blocks, closed) = haskellBlocks src
+    runTest c (label ++ " haskell fences closed") (pure closed)
+    forM_ (zip [1 :: Int ..] blocks) (\\(i, blk) ->
+      runTest c (label ++ " haskell block " ++ show i ++ " well-formed")
+        (pure (not (null (trimWs blk)) && balanced blk))))
+`)
+  })
+})
+
+
+export {
+  ReadmeExamplesTest
+}

package/.sdk/src/cmp/haskell/ReadmeExplanation_haskell.ts

@@ -0,0 +1,48 @@
+
+import { cmp, Content } from '@voxgig/sdkgen'
+
+
+const ReadmeExplanation = cmp(function ReadmeExplanation(props: any) {
+  const { target, ctx$: { model } } = props
+
+  Content(`### Data as struct Values
+
+The Haskell SDK models every API record as the dynamic \`Value\` type (from
+the vendored \`VoxgigStruct\` module) rather than bespoke Haskell records.
+This mirrors the dynamic nature of the API and keeps the SDK flexible — no
+new datatypes or code generation are needed when the API schema changes.
+
+Build request maps with \`jo [(key, value)]\` and read fields back with
+\`getp value "field"\`; scalars are the \`VStr\` / \`VNum\` / \`VBool\`
+constructors, and \`VNoval\` stands for an absent property.
+
+### Module structure
+
+\`\`\`
+${target.name}/
+├── src/
+│   ├── VoxgigStruct.hs   -- vendored dependency-free struct library (Value)
+│   ├── Vregex.hs         -- vendored regex support
+│   ├── SdkTypes.hs       -- core types (Client, Entity, Feature)
+│   ├── SdkHelpers.hs     -- helper functions (jo, getp, ...)
+│   ├── SdkRuntime.hs     -- the generic operation pipeline
+│   ├── SdkFeatures.hs    -- built-in features + makeEntity
+│   ├── SdkConfig.hs      -- generated API configuration + feature factory
+│   └── SdkClient.hs      -- generated public client (newSdk, entity accessors)
+├── test/                 -- test suites
+├── Makefile              -- stock-GHC build/test (no third-party deps)
+└── ${model.const.Name.toLowerCase()}-sdk.cabal      -- package manifest (for Hackage)
+\`\`\`
+
+The public module (\`SdkClient\`) exports the SDK constructors (\`newSdk\`,
+\`testSdk\`) and one accessor per entity. Import \`VoxgigStruct\` for the
+\`Value\` constructors and \`SdkHelpers\` for \`jo\` / \`getp\`.
+
+`)
+
+})
+
+
+export {
+  ReadmeExplanation
+}