packages feed

keel (empty) → 0.1.0.0

raw patch · 10 files changed

+734/−0 lines, 10 filesdep +SHAdep +basedep +bytestring

Dependencies added: SHA, base, bytestring, dataframe-core, directory, filepath, keel, keel-abi, keel-dyn, keel-linalg, keel-onnx, process, text, vector

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for keel++## 0.1.0.0 -- 2026-08-18++* First release.
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Zhe Zhang++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.
+ README.md view
@@ -0,0 +1,32 @@+# keel++The umbrella over the keel capability packages+([keel-dyn](https://hackage.haskell.org/package/keel-dyn),+[keel-abi](https://hackage.haskell.org/package/keel-abi),+[keel-linalg](https://hackage.haskell.org/package/keel-linalg),+[keel-onnx](https://hackage.haskell.org/package/keel-onnx)):++- `keel doctor` — reports exactly which native capabilities resolve on+  this machine, which do not, and the one command that fixes each;+- `keel setup <openblas|onnx>` — checksum-pinned installation of the+  native runtimes into the per-user keel directory;+- `Keel.Bridge` — the explicit frame ↔ buffer copy between+  [dataframe](https://hackage.haskell.org/package/dataframe-core)+  columns and the `Storable` buffers keel-linalg and keel-abi take.+  Nulls are refused, not imputed.++```text+$ keel doctor+[ok]  keel-dyn      pure Haskell over the OS loader; no native dependency+[ok]  keel-abi      frozen C ABI structs, hand-laid-out; no native dependency+[ok]  keel-linalg   OpenBLAS 0.3.30 ...+[ok]  keel-onnx     ONNX Runtime 1.24.4 ...+```++keel is deliberately NOT a dataframe, a schema layer, an estimator+protocol, or a numeric prelude. It is the Windows-first capability and+interop floor for doing data science in Haskell: load native+capability, exchange buffers with the ecosystem, verify the setup.++Tutorials and the full design rationale live in the+[project repository](https://github.com/skymanbp/keel).
+ app/Main.hs view
@@ -0,0 +1,47 @@+-- | The @keel@ executable: @keel doctor@ and @keel setup {blas,onnx}@.+module Main (main) where++import System.Environment (getArgs)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr)++import Keel.Doctor+import Keel.Setup++main :: IO ()+main = do+  args <- getArgs+  case args of+    [] -> runDoctor+    ["doctor"] -> runDoctor+    ["setup", "blas"] -> runSetup "OpenBLAS" setupBlas+    ["setup", "onnx"] -> runSetup "ONNX Runtime" setupOnnx+    _ -> do+      hPutStrLn stderr "usage: keel [doctor | setup blas | setup onnx]"+      exitFailure++runDoctor :: IO ()+runDoctor = do+  reports <- diagnose+  putStrLn "keel doctor\n"+  putStr (renderReports reports)+  if allAvailable reports+    then putStrLn "\nall capabilities available"+    else do+      putStrLn "\nsome capabilities need attention (see fixes above)"+      exitFailure++runSetup :: String -> IO (Either SetupError FilePath) -> IO ()+runSetup what act = do+  putStrLn ("installing " <> what <> " (official archive, SHA-256 pinned) ...")+  r <- act+  case r of+    Right dir -> do+      putStrLn ("installed to " <> dir)+      putStrLn "run 'keel doctor' to verify"+    Left (UnsupportedPlatform _ guidance) -> do+      hPutStrLn stderr ("not available for this platform: " <> guidance)+      exitFailure+    Left err -> do+      hPutStrLn stderr ("setup failed: " <> show err)+      exitFailure
+ keel.cabal view
@@ -0,0 +1,88 @@+cabal-version:      3.0+name:               keel+version:            0.1.0.0+synopsis:           Umbrella for the keel capability floor: doctor, setup+description:+    The thin seam over the keel capability packages (keel-dyn, keel-abi,+    keel-onnx, keel-linalg):+    .+    * @keel doctor@ — reports exactly which native capabilities resolve+      on this machine, which do not, and the one command that fixes+      each;+    * @keel setup@ — checksum-pinned installation of native runtimes+      into the per-user keel directory.+    .+    keel is deliberately NOT a dataframe, a schema layer, an estimator+    protocol, or a numeric prelude — see the project README.+license:            MIT+license-file:       LICENSE+author:             Zhe Zhang+maintainer:         Zhe Zhang+category:           Data Science+build-type:         Simple+homepage:           https://github.com/skymanbp/keel+bug-reports:        https://github.com/skymanbp/keel/issues+extra-doc-files:+    CHANGELOG.md+    README.md+tested-with:        GHC ==9.10.3 || ==9.12.4 || ==9.14.1++source-repository head+    type:     git+    location: https://github.com/skymanbp/keel++common warnings+    ghc-options:      -Wall+    default-language: GHC2021++library+    import:           warnings+    exposed-modules:+        Keel.Bridge+        Keel.Doctor+        Keel.Setup+    hs-source-dirs:   src+    build-depends:+        SHA >=1.6 && <1.7,+        base >=4.20 && <4.23,+        bytestring >=0.11 && <0.13,+        dataframe-core >=2.4 && <2.5,+        directory >=1.3 && <1.4,+        filepath >=1.4 && <1.6,+        keel-abi >=0.1 && <0.2,+        keel-dyn >=0.1 && <0.2,+        keel-linalg >=0.1 && <0.2,+        keel-onnx >=0.1 && <0.2,+        process >=1.6 && <1.7,+        text >=2.0 && <2.2,+        vector >=0.13 && <0.14++executable keel+    import:           warnings+    main-is:          Main.hs+    hs-source-dirs:   app+    ghc-options:      -threaded+    build-depends:+        base,+        keel++test-suite keel-doctor-test+    import:           warnings+    type:             exitcode-stdio-1.0+    main-is:          DoctorTest.hs+    hs-source-dirs:   test+    build-depends:+        base,+        keel++test-suite keel-bridge-test+    import:           warnings+    type:             exitcode-stdio-1.0+    main-is:          BridgeTest.hs+    hs-source-dirs:   test+    build-depends:+        base,+        dataframe-core,+        keel,+        text,+        vector
+ src/Keel/Bridge.hs view
@@ -0,0 +1,90 @@+-- | The explicit frame ↔ buffer copy: dataframe 'Column's to+-- 'VS.Vector' buffers (ready for keel-linalg \/ keel-abi) and back.+--+-- This module is keel's ONLY point of contact with the dataframe stack,+-- and it is honest about the cost: every conversion here is an O(n)+-- copy — dataframe's unboxed columns and Storable vectors are different+-- memory representations, exactly the trade numpy↔pandas makes. No API+-- here pretends a zero-copy path exists where the representation cannot+-- provide one.+--+-- Nulls are refused, not imputed: a column with missing values raises+-- 'ColumnHasNulls' — fill or drop them with dataframe's own operations+-- first, where that decision belongs.+module Keel.Bridge+  ( BridgeError (..)+  , columnToStorable+  , columnsToMatrix+  , storableToColumn+  ) where++import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Vector.Generic qualified as VG+import Data.Vector.Storable qualified as VS++import DataFrame.Internal.Column+  ( Column+  , columnLength+  , fromUnboxedVector+  , numElements+  , toUnboxedVector+  )+import DataFrame.Internal.DataFrame (DataFrame, getColumn)++-- | Why a frame ↔ buffer conversion was refused.+data BridgeError+  = ColumnNotFound T.Text+    -- ^ No column of that name in the frame.+  | ColumnHasNulls T.Text Int+    -- ^ The column has this many missing values; handle them in+    -- dataframe first (fill\/drop) — the bridge never imputes.+  | ColumnTypeMismatch T.Text String+    -- ^ The column does not hold @Double@s (upstream's own type error+    -- is carried verbatim).+  | ColumnLengthMismatch T.Text Int Int+    -- ^ (column, expected rows, actual rows) while assembling a matrix.+    -- Defensive: dataframe pads short columns with nulls on insert, so+    -- columns from one frame are always equal-length (a padded column+    -- trips 'ColumnHasNulls' first); this guards the invariant anyway.+  deriving (Eq, Show)++-- | O(n) copy of a @Double@ column out of a frame into a Storable+-- buffer.+columnToStorable :: DataFrame -> T.Text -> Either BridgeError (VS.Vector Double)+columnToStorable df name = do+  col <- maybe (Left (ColumnNotFound name)) Right (getColumn name df)+  let nulls = columnLength col - numElements col+  if nulls > 0+    then Left (ColumnHasNulls name nulls)+    else case toUnboxedVector col of+      Left e -> Left (ColumnTypeMismatch name (show e))+      Right vu -> Right (VG.convert vu)++-- | O(n·k) copy of @k@ same-length @Double@ columns into one row-major+-- @rows × k@ matrix (the layout every keel-linalg driver takes).+-- Returns the row count alongside the buffer.+columnsToMatrix :: DataFrame -> [T.Text] -> Either BridgeError (Int, VS.Vector Double)+columnsToMatrix df names = do+  cols <- traverse (\n -> (,) n <$> columnToStorable df n) names+  case cols of+    [] -> Right (0, VS.empty)+    (_, c0) : rest -> do+      let m = VS.length c0+      mapM_+        ( \(n, c) ->+            if VS.length c == m+              then Right ()+              else Left (ColumnLengthMismatch n m (VS.length c))+        )+        rest+      let k = length cols+          -- boxed vector for O(1) column lookup per cell (a list here+          -- makes the copy O(n·k²), belying the O(n·k) contract above)+          vecs = V.fromList (map snd cols)+      Right (m, VS.generate (m * k) (\i -> (vecs V.! (i `mod` k)) VS.! (i `div` k)))++-- | O(n) copy of a Storable buffer back into a (null-free) dataframe+-- column, e.g. to insert a keel-linalg result as a new column.+storableToColumn :: VS.Vector Double -> Column+storableToColumn = fromUnboxedVector . VG.convert
+ src/Keel/Doctor.hs view
@@ -0,0 +1,147 @@+-- | @keel doctor@: probe every keel capability on this machine and say+-- exactly what resolved, what did not, and the one command that fixes+-- each gap. Pure diagnosis — nothing is downloaded or modified.+module Keel.Doctor+  ( CapStatus (..)+  , CapabilityReport (..)+  , diagnose+  , renderReports+  , allAvailable+  ) where++import Keel.Dyn (capLibrary, libraryPath)+import Keel.Linalg+  ( BackendError (..)+  , backendConfig+  , closeBackend+  , openBackend+  )+import Keel.Onnx (OnnxError (..), loadOnnxRuntime, ortVersion)++-- | Outcome of probing one capability.+data CapStatus+  = Available+    -- ^ Resolved and answered a version probe.+  | Missing+    -- ^ Nothing found by the search policy; installable.+  | Broken+    -- ^ Something was found but is unusable (wrong build, too old,+    -- symbols absent).+  deriving (Eq, Show)++-- | One line of the doctor's report.+data CapabilityReport = CapabilityReport+  { capName :: String+  , capStatus :: CapStatus+  , capDetail :: String+    -- ^ Version\/config\/path on success; the reason otherwise.+  , capFix :: Maybe String+    -- ^ The one command that fixes it, when there is one.+  }+  deriving (Eq, Show)++-- | Probe everything. Never throws; each probe folds its failure into+-- the report.+diagnose :: IO [CapabilityReport]+diagnose =+  sequence+    [ pure dynReport+    , pure abiReport+    , blasReport+    , onnxReport+    ]++dynReport :: CapabilityReport+dynReport =+  CapabilityReport+    "keel-dyn"+    Available+    "pure Haskell over the OS loader; no native dependency"+    Nothing++abiReport :: CapabilityReport+abiReport =+  CapabilityReport+    "keel-abi"+    Available+    "frozen C ABI structs, hand-laid-out; no native dependency"+    Nothing++blasFix :: Maybe String+blasFix = Just "keel setup blas   (or point KEEL_OPENBLAS at a stock LP64 libopenblas)"++blasReport :: IO CapabilityReport+blasReport = do+  r <- openBackend+  case r of+    Right be -> do+      let detail = backendConfig be <> "  @ " <> libraryPath (capLibrary be)+      closeBackend be+      pure (CapabilityReport "keel-linalg (OpenBLAS)" Available detail Nothing)+    Left err ->+      pure $ case err of+        BackendNotFound _ ->+          CapabilityReport "keel-linalg (OpenBLAS)" Missing+            "no OpenBLAS found via KEEL_OPENBLAS, the keel data dir, or the system search path"+            blasFix+        BackendNotOpenBLAS p ->+          CapabilityReport "keel-linalg (OpenBLAS)" Broken+            ("library at " <> p <> " exports no openblas_get_config; only OpenBLAS is supported")+            blasFix+        BackendILP64 cfg ->+          CapabilityReport "keel-linalg (OpenBLAS)" Broken+            ("ILP64 build refused (would corrupt silently): " <> cfg)+            blasFix+        BackendMissingSymbol e ->+          CapabilityReport "keel-linalg (OpenBLAS)" Broken+            ("required symbol absent (symbol-renamed or LAPACKE-less build): " <> show e)+            blasFix++onnxFix :: Maybe String+onnxFix = Just "keel setup onnx   (or point KEEL_ONNXRUNTIME at the official onnxruntime library)"++onnxReport :: IO CapabilityReport+onnxReport = do+  r <- loadOnnxRuntime+  case r of+    -- deliberately not closed: onnxruntime owns thread pools and+    -- unloading at process end is the safe path+    Right ort ->+      pure+        ( CapabilityReport "keel-onnx (ONNX Runtime)" Available+            ("ONNX Runtime " <> ortVersion ort <> "  @ " <> libraryPath (capLibrary ort))+            Nothing+        )+    Left err ->+      pure $ case err of+        OnnxRuntimeNotFound _ ->+          CapabilityReport "keel-onnx (ONNX Runtime)" Missing+            "no ONNX Runtime found via KEEL_ONNXRUNTIME, the keel data dir, or the system search path"+            onnxFix+        OnnxApiUnsupported v ->+          CapabilityReport "keel-onnx (ONNX Runtime)" Broken+            ("a runtime was found but is older than C API version " <> show v+              <> " (a stray old onnxruntime on PATH shadows the good one)")+            onnxFix+        other ->+          CapabilityReport "keel-onnx (ONNX Runtime)" Broken (show other) onnxFix++-- | @True@ when every probed capability is 'Available'.+allAvailable :: [CapabilityReport] -> Bool+allAvailable = all ((== Available) . capStatus)++-- | Plain-text rendering, one capability per block.+renderReports :: [CapabilityReport] -> String+renderReports reports = unlines (concatMap block reports)+  where+    block r =+      (tag (capStatus r) <> "  " <> pad (capName r) <> "  " <> capDetail r)+        : case (capStatus r, capFix r) of+            (Available, _) -> []+            (_, Just fix) -> ["          fix: " <> fix]+            _ -> []+    tag Available = "[ok]     "+    tag Missing = "[MISSING]"+    tag Broken = "[BROKEN] "+    width = maximum (map (length . capName) reports)+    pad s = s <> replicate (width - length s) ' '
+ src/Keel/Setup.hs view
@@ -0,0 +1,179 @@+-- | @keel setup@: install pinned native runtimes into the per-user+-- keel directory ("Keel.Dyn.Locate"'s second search stage).+--+-- Every artifact is an /official upstream release archive/, pinned by+-- URL and SHA-256 (values computed from the downloaded archives,+-- 2026-08-18). The tools used are deliberately boring: the system's+-- @curl@ and @tar@ (Windows 10+ ships both; the System32 bsdtar also+-- unpacks zip), plus a pure-Haskell SHA-256 — keel's zero-native-deps+-- rule applies to keel itself.+--+-- Offline\/air-gapped environments skip @keel setup@ entirely: point+-- @KEEL_OPENBLAS@ \/ @KEEL_ONNXRUNTIME@ at an existing library, or drop+-- one into the keel data dir yourself.+module Keel.Setup+  ( SetupError (..)+  , setupBlas+  , setupOnnx+  ) where++import Control.Exception (Exception)+import Control.Monad (filterM, forM_, when)+import Data.ByteString.Lazy qualified as BL+import Data.Digest.Pure.SHA (sha256, showDigest)+import System.Directory+  ( copyFile+  , createDirectoryIfMissing+  , doesDirectoryExist+  , doesFileExist+  , getTemporaryDirectory+  , listDirectory+  , removeDirectoryRecursive+  , removeFile+  )+import System.Environment (lookupEnv)+import System.Exit (ExitCode (..))+import System.FilePath (dropExtension, takeFileName, (</>))+import System.Info (arch, os)+import System.Process (proc, readCreateProcessWithExitCode)++import Keel.Dyn.Locate (keelNativeDir)++-- | Why an installation could not happen.+data SetupError+  = UnsupportedPlatform String String+    -- ^ (capability, guidance) — no pinned artifact for this OS\/arch;+    -- the guidance says what to do instead.+  | DownloadFailed String String+    -- ^ (url, tool output).+  | ChecksumMismatch String String String+    -- ^ (url, expected, got) — the archive is deleted before this is+    -- thrown.+  | ExtractFailed String String+    -- ^ (archive, tool output).+  deriving (Eq, Show)++instance Exception SetupError++data Artifact = Artifact+  { artCapability :: String+    -- ^ keel data-dir name ('keelNativeDir' argument).+  , artUrl :: String+  , artSha256 :: String+    -- ^ Lowercase hex, pinned.+  , artLibSubdir :: FilePath+    -- ^ Directory inside the archive whose files become the payload.+  , artAttribution :: String+    -- ^ Upstream project + license, recorded next to the payload.+  }++-- | Install OpenBLAS (LP64) for keel-linalg. Pinned artifact exists for+-- Windows x86_64 (upstream publishes binaries only there); on other+-- platforms the package manager is the right tool and 'setupBlas'+-- returns the exact command as 'UnsupportedPlatform' guidance.+setupBlas :: IO (Either SetupError FilePath)+setupBlas = case (os, arch) of+  ("mingw32", "x86_64") ->+    install+      Artifact+        { artCapability = "openblas"+        , artUrl = "https://github.com/OpenMathLib/OpenBLAS/releases/download/v0.3.30/OpenBLAS-0.3.30-x64.zip"+        , artSha256 = "8b04387766efc05c627e26d24797ec0d4ed4c105ec14fa7400aa84a02db22b66"+        , artLibSubdir = "bin"+        , artAttribution =+            "libopenblas.dll from OpenBLAS 0.3.30 (BSD-3-Clause), official release archive:\n\+            \https://github.com/OpenMathLib/OpenBLAS/releases/tag/v0.3.30\n"+        }+  ("linux", _) ->+    pure (Left (UnsupportedPlatform "openblas"+      "upstream publishes no Linux binaries; run: sudo apt-get install libopenblas0 (or your distro's equivalent)"))+  ("darwin", _) ->+    pure (Left (UnsupportedPlatform "openblas"+      "upstream publishes no macOS binaries; run: brew install openblas, then set KEEL_OPENBLAS=$(brew --prefix openblas)/lib/libopenblas.dylib"))+  _ ->+    pure (Left (UnsupportedPlatform "openblas" (os <> "/" <> arch <> " has no pinned artifact")))++-- | Install ONNX Runtime for keel-onnx from the official (MIT) release+-- archives: win-x64, linux-x64 and osx-arm64 are pinned.+setupOnnx :: IO (Either SetupError FilePath)+setupOnnx = case (os, arch) of+  ("mingw32", "x86_64") ->+    install (onnxArtifact "onnxruntime-win-x64-1.24.4.zip"+      "d2319fddfb6ea4db99ccc4b60c85c517bcd855721f5daa6a06d40d7cb2ee2357")+  ("linux", "x86_64") ->+    install (onnxArtifact "onnxruntime-linux-x64-1.24.4.tgz"+      "3a211fbea252c1e66290658f1b735b772056149f28321e71c308942cdb54b747")+  ("darwin", "aarch64") ->+    install (onnxArtifact "onnxruntime-osx-arm64-1.24.4.tgz"+      "93787795f47e1eee369182e43ed51b9e5da0878ab0346aecf4258979b8bba989")+  _ ->+    pure (Left (UnsupportedPlatform "onnxruntime"+      (os <> "/" <> arch <> " has no pinned artifact; official archives cover win-x64, linux-x64, osx-arm64")))+  where+    onnxArtifact file sha =+      Artifact+        { artCapability = "onnxruntime"+        , artUrl = "https://github.com/microsoft/onnxruntime/releases/download/v1.24.4/" <> file+        , artSha256 = sha+        , -- archives unpack as <basename minus .zip/.tgz>/lib/...+          artLibSubdir = dropExtension file </> "lib"+        , artAttribution =+            "ONNX Runtime 1.24.4 (MIT), official release archive:\n\+            \https://github.com/microsoft/onnxruntime/releases/tag/v1.24.4\n"+        }++-- ---------------------------------------------------------------------++install :: Artifact -> IO (Either SetupError FilePath)+install art = do+  destDir <- keelNativeDir (artCapability art)+  createDirectoryIfMissing True destDir+  tmp <- getTemporaryDirectory+  let archPath = tmp </> takeFileName (artUrl art)+      exDir = tmp </> (artCapability art <> "-keel-extract")++  (dlCode, _, dlErr) <-+    readCreateProcessWithExitCode (proc "curl" ["-fsSL", "-o", archPath, artUrl art]) ""+  case dlCode of+    ExitFailure _ -> pure (Left (DownloadFailed (artUrl art) dlErr))+    ExitSuccess -> do+      got <- showDigest . sha256 <$> BL.readFile archPath+      if got /= artSha256 art+        then do+          removeFile archPath+          pure (Left (ChecksumMismatch (artUrl art) (artSha256 art) got))+        else do+          exExists <- doesDirectoryExist exDir+          when exExists (removeDirectoryRecursive exDir)+          createDirectoryIfMissing True exDir+          t <- tarExe+          (exCode, _, exErr) <-+            readCreateProcessWithExitCode (proc t ["-xf", archPath, "-C", exDir]) ""+          case exCode of+            ExitFailure _ -> do+              removeFile archPath+              pure (Left (ExtractFailed archPath exErr))+            ExitSuccess -> do+              let srcLib = exDir </> artLibSubdir art+              entries <- listDirectory srcLib+              files <- filterM (doesFileExist . (srcLib </>)) entries+              if null files+                then do+                  removeFile archPath+                  removeDirectoryRecursive exDir+                  pure (Left (ExtractFailed archPath ("no payload files under " <> artLibSubdir art)))+                else do+                  forM_ files $ \f -> copyFile (srcLib </> f) (destDir </> f)+                  writeFile (destDir </> "ATTRIBUTION.txt") (artAttribution art)+                  removeFile archPath+                  removeDirectoryRecursive exDir+                  pure (Right destDir)++-- On Windows, PATH often puts GNU tar (MSYS/Git) first, which cannot+-- unpack zip; the System32 bsdtar can, so use it by absolute path.+tarExe :: IO FilePath+tarExe = case os of+  "mingw32" -> do+    root <- lookupEnv "SystemRoot"+    pure (maybe "tar" (\r -> r </> "System32" </> "tar.exe") root)+  _ -> pure "tar"
+ test/BridgeTest.hs view
@@ -0,0 +1,90 @@+-- | Bridge invariants: the copy round-trips exactly, every refusal path+-- (missing column, wrong type, nulls, ragged lengths) fires, and the+-- matrix layout is row-major as keel-linalg expects.+module Main (main) where++import Control.Monad (unless)+import Data.Text qualified as T+import Data.Vector.Storable qualified as VS++import DataFrame.Internal.Column (Column, columnLength, fromList, fromUnboxedVector, numElements)+import DataFrame.Internal.DataFrame (DataFrame, fromNamedColumns)+import Data.Vector.Unboxed qualified as VU+import Keel.Bridge++expect :: Bool -> String -> IO ()+expect ok msg = unless ok (fail msg)++col :: [Double] -> Column+col = fromUnboxedVector . VU.fromList++frame :: DataFrame+frame =+  fromNamedColumns+    [ (T.pack "x", col [1, 2, 3])+    , (T.pack "y", col [4, 5, 6])+    , (T.pack "short", col [7, 8])+    , (T.pack "ints", fromList [1 :: Int, 2, 3])+    , (T.pack "holey", fromList [Just (1 :: Double), Nothing, Just 3])+    ]++main :: IO ()+main = do+  -- sanity: the Maybe column really carries a null per dataframe itself+  let holey = fromList [Just (1 :: Double), Nothing, Just 3]+  expect (columnLength holey == 3 && numElements holey == 2)+    ("null column not represented as expected: length "+      <> show (columnLength holey) <> ", elements " <> show (numElements holey))++  -- round-trip: frame -> buffer -> column -> buffer, exact+  x <- either (fail . show) pure (columnToStorable frame (T.pack "x"))+  expect (VS.toList x == [1, 2, 3]) ("columnToStorable: " <> show (VS.toList x))+  let back = storableToColumn x+      reframe = fromNamedColumns [(T.pack "x2", back)]+  x2 <- either (fail . show) pure (columnToStorable reframe (T.pack "x2"))+  expect (VS.toList x2 == [1, 2, 3]) ("round-trip: " <> show (VS.toList x2))++  -- refusals (ColumnLengthMismatch is unreachable through a real frame:+  -- dataframe pads short columns with nulls on insert, so the "short"+  -- column must surface as ColumnHasNulls instead — assert exactly that)+  expect (isLeft (columnToStorable frame (T.pack "nope")) ColumnNotFound')+    "missing column not refused"+  expect (isLeft (columnToStorable frame (T.pack "ints")) ColumnTypeMismatch')+    "Int column not refused for Double extraction"+  expect (isLeft (columnToStorable frame (T.pack "holey")) ColumnHasNulls')+    "null-bearing column not refused"+  expect (isLeft (columnsToMatrix frame [T.pack "x", T.pack "short"]) ColumnHasNulls')+    "frame-padded short column not refused as null-bearing"++  -- row-major layout: [x | y] as 3x2 must interleave rows+  (m, mat) <- either (fail . show) pure (columnsToMatrix frame [T.pack "x", T.pack "y"])+  expect (m == 3) ("matrix rows: " <> show m)+  expect (VS.toList mat == [1, 4, 2, 5, 3, 6])+    ("row-major layout: " <> show (VS.toList mat))++  -- wide frame: k=100 columns of 5 rows, cell (i,j) holds 100*i + j,+  -- which in row-major layout equals its own flat index — checks the+  -- per-cell column lookup and the layout at width in one identity+  let wideCols =+        [ (T.pack ("c" <> show j), col [fromIntegral (100 * i + j) | i <- [0 .. 4 :: Int]])+        | j <- [0 .. 99 :: Int]+        ]+  (wm, wmat) <- either (fail . show) pure (columnsToMatrix (fromNamedColumns wideCols) (map fst wideCols))+  expect (wm == 5) ("wide matrix rows: " <> show wm)+  expect (VS.length wmat == 500) ("wide matrix size: " <> show (VS.length wmat))+  expect (wmat == VS.generate 500 fromIntegral)+    "wide matrix cells differ from their flat index"++  putStrLn "keel-bridge-test: round-trip, refusals and layout all verified"++-- lightweight constructor tags for refusal checks+data ErrTag = ColumnNotFound' | ColumnHasNulls' | ColumnTypeMismatch' | ColumnLengthMismatch'++isLeft :: Either BridgeError a -> ErrTag -> Bool+isLeft (Left e) tag = case (e, tag) of+  (ColumnNotFound _, ColumnNotFound') -> True+  (ColumnHasNulls _ _, ColumnHasNulls') -> True+  (ColumnTypeMismatch _ _, ColumnTypeMismatch') -> True+  (ColumnLengthMismatch {}, ColumnLengthMismatch') -> True+  _ -> False+isLeft (Right _) _ = False
+ test/DoctorTest.hs view
@@ -0,0 +1,35 @@+-- | Doctor sanity: the diagnosis runs to completion on any machine,+-- the two pure capabilities always report Available, and the renderer+-- produces a line (plus fix line where applicable) per capability.+-- Whether BLAS/ONNX are Available depends on the machine, so those+-- statuses are only checked for consistency, not for a fixed value.+module Main (main) where++import Control.Monad (forM_, unless)++import Keel.Doctor++expect :: Bool -> String -> IO ()+expect ok msg = unless ok (fail msg)++main :: IO ()+main = do+  reports <- diagnose+  expect (length reports == 4) ("expected 4 capability reports, got " <> show (length reports))++  let byName n = filter ((== n) . capName) reports+  expect (map capStatus (byName "keel-dyn") == [Available]) "keel-dyn not Available"+  expect (map capStatus (byName "keel-abi") == [Available]) "keel-abi not Available"++  forM_ reports $ \r -> do+    expect (not (null (capDetail r))) (capName r <> ": empty detail")+    case capStatus r of+      Available -> pure ()+      _ -> expect (capFix r /= Nothing) (capName r <> ": non-available without a fix")++  let rendered = renderReports reports+  expect (length (lines rendered) >= 4) "renderer lost capability lines"+  putStrLn rendered+  putStrLn ("keel-doctor-test: diagnosis completed ("+    <> show (length (filter ((== Available) . capStatus) reports))+    <> "/4 available on this machine)")