diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2026 XF-Interchange LLC + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,379 @@ +# glean-hs + +> Docker-free Haskell code indexing — built by [XF-Interchange LLC](https://xf-interchange.ai) + +[![License: MIT](https://img.shields.io/badge/License-MIT-yellow.svg)](LICENSE) + +--- + +## What is glean-hs? + +**glean-hs** lets you index a Haskell codebase and ask questions about it: + +```bash +# Where is this function defined? +glean-hs query --db ./mydb "validateCDTCode" + +# What calls this function? +glean-hs query --db ./mydb "ref:validateCDTCode" + +# What's in this module? +glean-hs query --db ./mydb "mod:SeidoClaims.Validation" +``` + +Think of it like indexing a database. Without an index, finding where a +function is defined means searching through every source file manually — +slow for large projects. glean-hs indexes your code once and answers any +question about it instantly, just like a database query. + +--- + +## The Problem it Solves + +[Meta Glean](https://github.com/facebookincubant/glean) is a powerful code +indexing system that supports Haskell. It enables go-to-definition across +modules, find-all-references, dead code detection, and dependency analysis. + +**The barrier:** Glean requires Docker because its C++ dependencies +(`folly`, `RocksDB`, `fbthrift`) are difficult to build natively on +macOS and Windows. + +**glean-hs eliminates the Docker requirement** by reimplementing those C++ +dependencies in Rust: + +``` +C++ dependency → Rust equivalent +──────────────────────────────────── +RocksDB → rust-rocksdb +folly utilities → Rust standard library + crates +fbthrift → avoided entirely +``` + +--- + +## Quick Start + +### Step 1 — Install the prerequisites + +You need two tools. Both install with a single command. + +**Rust** (the language our storage layer is written in): +```bash +curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs | sh +``` + +**GHC + Cabal** (the Haskell compiler and build tool): +```bash +curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | sh +ghcup install ghc 9.12.2 +ghcup set ghc 9.12.2 +``` + +> **Why version 9.12.2 specifically?** +> glean-hs uses GHC internal APIs for reading HIE files +> (`GHC.Iface.Ext.*`). These APIs change between major GHC versions. +> GHC 9.12.2 is the version glean-hs has been tested and built against. +> Using a different version may cause compilation errors. + +### Step 2 — Build glean-hs + +```bash +git clone https://github.com/XF-Interchange/glean-hs +cd glean-hs +cargo build --release # builds the Rust storage layer (~4 minutes first time) +``` + +**Before running `cabal build`**, create a local Cabal override file that +tells the Haskell build system where to find the Rust library you just built. +Run this once in the project root: + +```bash +echo "package glean-hs" > cabal.project.local +echo " extra-lib-dirs: $(pwd)/target/release" >> cabal.project.local +``` + +> This file is gitignored — it's specific to your machine and never +> committed to the repository. Every developer creates their own copy. + +Then build the Haskell layer: + +```bash +cabal build # builds the Haskell layer (~2 minutes first time) +``` + +### Step 3 — Index a Haskell project + +First, tell GHC to generate HIE files (the semantic data glean-hs reads): + +```bash +# In your Haskell project directory: +cabal build --ghc-options="-fwrite-ide-info -hiedir=.hie" +``` + +Then index it: + +```bash +cabal run glean-hs -- index --hie-dir .hie --db ./mydb --verbose +``` + +### Step 4 — Query it + +```bash +# Find where a function is defined +cabal run glean-hs -- query --db ./mydb "myFunction" + +# Find all references to a function +cabal run glean-hs -- query --db ./mydb "ref:myFunction" + +# Show glean-hs database statistics +cabal run glean-hs -- stats --db ./mydb +``` + +--- + +## Key Concepts + +### HIE Files — What They Are + +When GHC compiles your Haskell code, it understands everything about it — +what every name means, what type every expression has, and where every +function is defined. + +Normally GHC uses this knowledge just to compile your code and then +discards it. With the `-fwrite-ide-info` flag, GHC saves that knowledge +to `.hie` files in your project directory. + +glean-hs reads those `.hie` files. It doesn't parse your Haskell source +directly — GHC already did the hard work. glean-hs just reads what GHC +understood. + +You don't need to understand the format of these files. Just tell GHC to +generate them, and glean-hs handles the rest. + +### Facts and Predicates — Plain English + +A **fact** is one piece of information about your code. For example: + +> "The function `validateCDTCode` is defined in `SeidoClaims.Validation` at line 42" + +That's one fact. + +A **predicate** is the category a fact belongs to — think of it like a +table name in a database: + +| Predicate | What it stores | +|-----------|----------------| +| `src.Definition` | A name defined at a location | +| `src.Reference` | A name used at a location | +| `src.Module` | A Haskell module and its source file | +| `src.Import` | A module import relationship | + +glean-hs stores thousands of facts about your code. When you run a query, +it searches those facts and returns the ones that match. + +### Schema + +The schema defines what kinds of facts exist. glean-hs uses `src.1` — +a minimal, general-purpose schema the community can extend for their +own domains. See `haskell/schema/src.angle` and `haskell/schema/SCHEMA.md`. + +--- + +## Building on Different Operating Systems + +### macOS ✅ Tested + +Works out of the box. No extra steps. + +```bash +cargo build --release +cabal build +``` + +**About the linker warning:** + +You may see this during `cargo build`: +``` +ld: warning: object file was built for newer macOS version (26.x) than being linked (10.12) +``` + +**What causes it:** `librocksdb-sys` is compiled by your Rust toolchain +targeting your current macOS version. But Cargo's default minimum +deployment target is macOS 10.12 (2016) — a very old version set to +maximize compatibility. The linker sees the mismatch and warns you. + +**Why it's harmless:** The binary links and runs correctly on your machine. +It simply wouldn't run on actual macOS 10.12 — which nobody uses anymore. + +**To suppress it permanently** (add to your `~/.zshrc`): +```bash +export MACOSX_DEPLOYMENT_TARGET=14.0 +``` +This setting persists across macOS updates — you only need to set it once. + +### Linux ✅ Should work + +The same build steps apply. Community testing welcome — please open an +issue if you encounter problems. + +### Windows + +**Recommended: Use WSL2 (Windows Subsystem for Linux)** + +WSL2 is built into Windows 10 and 11 and gives you a full Linux environment. +It is the easiest path for Windows users — the Linux build steps work without +any extra configuration: + +```powershell +# In Windows PowerShell (run once to install WSL2): +wsl --install +``` + +After WSL2 is installed, open a WSL terminal and follow the +**Linux** build instructions above. + +**Bare Windows (without WSL2) — not recommended for new developers** + +Building on bare Windows requires: +1. [Visual Studio Build Tools](https://visualstudio.microsoft.com/) + with the **"Desktop development with C++"** workload +2. [LLVM](https://releases.llvm.org/) — check **"Add LLVM to system PATH"** +3. The first `cargo build --release` will take significantly longer + as it compiles RocksDB's C++ source from scratch + +If you are new to programming, WSL2 is strongly recommended over +bare Windows setup. + +--- + +## GHC Version Compatibility + +glean-hs is built and tested with **GHC 9.12.2**. + +The HIE indexer uses GHC internal APIs which may change between major +GHC versions. If you upgrade GHC, you may need to update the imports +in `haskell/src/Glean/Indexer/HIE.hs`. The `hie-compat` library +(already a dependency) abstracts some of these differences. + +--- + +## CLI Reference + +``` +glean-hs index --hie-dir DIR --db PATH [--verbose] [--max-files N] +glean-hs query --db PATH QUERY +glean-hs stats --db PATH +``` + +### Query syntax + +| Query | Returns | +|-------|---------| +| `"functionName"` | Definitions of that name | +| `"ref:functionName"` | References to that name | +| `"mod:Module.Name"` | All facts in that module | + +--- + +## Beyond Code Indexing + +glean-hs is not limited to Haskell code. Any structured knowledge domain +can be expressed as Glean facts and queried with Angle: + +- **Biological pathways** — genes, proteins, interactions +- **Transportation networks** — routes, carriers, schedules +- **Supply chains** — components, suppliers, shipments +- **Medical ontologies** — conditions, procedures, anatomy + +See `haskell/schema/src.angle` for the base schema. Extend it for your domain. + +*"It's all in the schemas."* + +--- + +## Known Limitations + +- **Query performance:** Currently O(n) — scans all stored batches. + Sufficient for small projects. Composite key storage planned for + large codebases (50K+ facts). + +- **Import indexing:** Import facts are stubbed — coming in a future release. + +- **Angle query language:** Full Angle integration is planned. Current + queries use direct storage access. + +- **cabal path warning:** A known warning about `target/release` path + during `cabal build` is harmless and does not affect functionality. + +--- + +## Project Structure + +``` +glean-hs/ +├── src/ +│ ├── rts/ # Rust runtime substrate +│ │ ├── id.rs # Id, Pid types +│ │ ├── fact.rs # Fact, Clause, FactRef +│ │ ├── factset.rs # Two-index FactSet +│ │ ├── bytecode/ # VM (opcode, frame, syscall, vm) +│ │ └── inventory.rs +│ └── storage/ +│ └── rocksdb.rs # C-ABI functions for Haskell FFI +├── haskell/ +│ ├── src/Glean/ +│ │ ├── FFI.hs # Rust FFI bindings +│ │ ├── Storage.hs # Storage typeclass +│ │ ├── RocksDB.hs # RocksDB implementation +│ │ ├── Query.hs # Direct query layer +│ │ └── Indexer/ +│ │ ├── HIE.hs # GHC HIE file reader +│ │ └── Types.hs # Fact types +│ ├── app/ +│ │ └── Main.hs # CLI +│ └── schema/ +│ ├── src.angle # Schema definition (DRAFT) +│ └── SCHEMA.md # Schema documentation +└── glean-hs.cabal +``` + +--- + +## Relationship to Meta Glean + +glean-hs is inspired by and compatible with +[Meta Glean](https://github.com/facebookincubator/glean). + +Meta Glean is a production-grade, battle-tested system running at massive +scale inside Meta. If you are on Linux and comfortable with Docker, +Meta Glean is worth evaluating directly. + +glean-hs solves a specific problem Meta Glean has: building natively on +macOS and Windows without Docker. It is not a replacement for Meta Glean — +it is a portable on-ramp to the same ecosystem. + +Schema compatibility with Meta Glean's `src.1` is a goal for future releases. + +--- + +## Contributing + +glean-hs is open source under the MIT license. + +See [CONTRIBUTING.md](CONTRIBUTING.md) for detailed information on: +- Priority contributions (composite keys, LMDB backend, domain schemas) +- How to write a new language indexer +- The fact serialization format specification +- Running the test suite +- Code style guidelines + +Open an issue or pull request at +[github.com/XF-Interchange/glean-hs](https://github.com/XF-Interchange/glean-hs). + +--- + +## License + +MIT — see [LICENSE](LICENSE) + +Built by [XF-Interchange LLC](https://xf-interchange.ai) diff --git a/glean-hs.cabal b/glean-hs.cabal new file mode 100644 --- /dev/null +++ b/glean-hs.cabal @@ -0,0 +1,108 @@ +cabal-version: 3.0 +name: glean-hs +version: 0.1.0 +synopsis: Docker-free Haskell code indexing via Rust-native Glean substrate +description: + glean-hs provides a native Rust reimplementation of Meta Glean's C++ + dependency substrate (folly + RocksDB + fbthrift), enabling Haskell code + indexing without Docker on macOS, Linux, and Windows. + +homepage: https://github.com/XF-Interchange/glean-hs +bug-reports: https://github.com/XF-Interchange/glean-hs/issues +license: MIT +license-file: LICENSE +author: XF-Interchange LLC +maintainer: dev@xf-interchange.ai +copyright: 2026 XF-Interchange LLC +category: Development, Language +build-type: Simple +extra-source-files: README.md + +source-repository head + type: git + location: https://github.com/XF-Interchange/glean-hs + +-- Common settings + +common common-options + default-language: GHC2021 + ghc-options: + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wno-name-shadowing + -Wpartial-fields + -Wredundant-constraints + +-- Single library (avoids typeclass instance conflicts) + +library + import: common-options + hs-source-dirs: haskell/src + exposed-modules: + Glean.FFI + Glean.Storage + Glean.RocksDB + Glean.Indexer.HIE + Glean.Indexer.Types + Glean.Query + + build-depends: + base >= 4.21.0 && < 4.22, + bytestring >= 0.12.2 && < 0.13, + containers >= 0.7 && < 0.8, + directory >= 1.3.9 && < 1.4, + filepath >= 1.5.4 && < 1.6, + ghc >= 9.12.2 && < 9.13, + hie-compat >= 0.3.1 && < 0.4, + text >= 2.1.2 && < 2.2, + transformers >= 0.6.1 && < 0.7, + + -- Link against our Rust substrate + -- Run: cargo build --release before cabal build + -- Then create cabal.project.local with: + -- echo "package glean-hs" > cabal.project.local + -- echo " extra-lib-dirs: $(pwd)/target/release" >> cabal.project.local + extra-libraries: glean_hs + +-- Command-line tool + +executable glean-hs + import: common-options + hs-source-dirs: haskell/app + main-is: Main.hs + + build-depends: + base >= 4.21.0 && < 4.22, + optparse-applicative >= 0.19.0 && < 0.20, + text >= 2.1.2 && < 2.2, + glean-hs, + + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +-- Tests + +test-suite glean-hs-test + import: common-options + type: exitcode-stdio-1.0 + hs-source-dirs: haskell/test + main-is: Spec.hs + other-modules: + Test.FFI + Test.Storage + Test.Indexer + + build-depends: + base >= 4.16 && < 5, + bytestring >= 0.11, + text >= 2.0, + hspec >= 2.10, + temporary >= 1.3, + filepath >= 1.4, + directory >= 1.3, + glean-hs, + + ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs new file mode 100644 --- /dev/null +++ b/haskell/app/Main.hs @@ -0,0 +1,209 @@ +-- | glean-hs command line tool. +-- +-- Index Haskell projects and query the resulting fact database. +-- +-- Usage: +-- glean-hs index --hie-dir .hie --db /tmp/mydb +-- glean-hs query --db /tmp/mydb "validateCDTCode" +-- glean-hs query --db /tmp/mydb "ref:validateCDTCode" +-- glean-hs query --db /tmp/mydb "mod:Glean.Storage" + +module Main (main) where + +import Control.Exception (catch, SomeException, displayException) +import Data.Text (Text) +import qualified Data.Text as Text +import Options.Applicative +import System.Exit (exitFailure) +import System.IO (hPutStrLn, stderr) + +import Glean.RocksDB (RocksDB) +import Glean.Storage +import Glean.Indexer.HIE +import Glean.Indexer.Types +import Glean.Query + +-- ── CLI options ─────────────────────────────────────────────────────────────── + +data Command + = Index IndexOptions + | Query QueryOptions + | Stats StatsOptions + deriving (Show) + +data IndexOptions = IndexOptions + { idxHieDir :: FilePath + , idxDbPath :: FilePath + , idxVerbose :: Bool + , idxMaxFiles :: Maybe Int + } deriving (Show) + +data QueryOptions = QueryOptions + { qryDbPath :: FilePath + , qryQuery :: Text + } deriving (Show) + +data StatsOptions = StatsOptions + { stDbPath :: FilePath + } deriving (Show) + +-- ── Parsers ─────────────────────────────────────────────────────────────────── + +indexOptions :: Parser IndexOptions +indexOptions = IndexOptions + <$> strOption + ( long "hie-dir" + <> metavar "DIR" + <> value ".hie" + <> showDefault + <> help "Directory containing .hie files" ) + <*> strOption + ( long "db" + <> metavar "PATH" + <> help "Path to the glean-hs database" ) + <*> switch + ( long "verbose" + <> short 'v' + <> help "Print progress information" ) + <*> optional (option auto + ( long "max-files" + <> metavar "N" + <> help "Maximum number of HIE files to index" )) + +queryOptions :: Parser QueryOptions +queryOptions = QueryOptions + <$> strOption + ( long "db" + <> metavar "PATH" + <> help "Path to the glean-hs database" ) + <*> ( Text.pack <$> argument str + ( metavar "QUERY" + <> help "Query string. Prefix with ref: for references, mod: for modules" )) + +statsOptions :: Parser StatsOptions +statsOptions = StatsOptions + <$> strOption + ( long "db" + <> metavar "PATH" + <> help "Path to the glean-hs database" ) + +commandParser :: Parser Command +commandParser = subparser + ( command "index" + ( info (Index <$> indexOptions) + (progDesc "Index a Haskell project from HIE files") ) + <> command "query" + ( info (Query <$> queryOptions) + (progDesc "Query the fact database") ) + <> command "stats" + ( info (Stats <$> statsOptions) + (progDesc "Show database statistics") ) + ) + +opts :: ParserInfo Command +opts = info (commandParser <**> helper) + ( fullDesc + <> progDesc "glean-hs: Docker-free Haskell code indexing" + <> header "glean-hs - XF-Interchange LLC" ) + +-- ── Command handlers ────────────────────────────────────────────────────────── + +runIndex :: IndexOptions -> IO () +runIndex options = do + let config = defaultDbConfig (idxDbPath options) + let idxCfg = defaultIndexConfig + { cfgHieDir = idxHieDir options + , cfgVerbose = idxVerbose options + , cfgMaxFiles = idxMaxFiles options + } + withStorage config $ \(db :: RocksDB) -> do + stats <- indexProject db idxCfg + putStrLn $ "Indexed " ++ show (statsFilesIndexed stats) ++ " files" + putStrLn $ " " ++ show (statsDefsFound stats) ++ " definitions" + putStrLn $ " " ++ show (statsRefsFound stats) ++ " references" + putStrLn $ " " ++ show (statsModulesFound stats) ++ " modules" + when (statsErrors stats > 0) $ + putStrLn $ " " ++ show (statsErrors stats) ++ " errors" + where + when True action = action + when False _ = return () + +runQuery :: QueryOptions -> IO () +runQuery options = do + let config = (defaultDbConfig (qryDbPath options)) + { dbReadOnly = True + , dbCreate = False + } + withStorage config $ \(db :: RocksDB) -> do + let q = qryQuery options + putStrLn $ "Query: " ++ Text.unpack q + if Text.pack "ref:" `Text.isPrefixOf` q + then do + refs <- findReferences db (Text.drop 4 q) + if null refs + then putStrLn "No references found." + else do + putStrLn $ "Found " ++ show (length refs) ++ " reference(s):" + mapM_ printRef refs + else if Text.pack "mod:" `Text.isPrefixOf` q + then do + facts <- findByModule db (Text.drop 4 q) + if null facts + then putStrLn "No facts found for module." + else putStrLn $ "Found " ++ show (length facts) ++ " fact(s) in module." + else do + defs <- findDefinitions db q + if null defs + then putStrLn "No definitions found." + else do + putStrLn $ "Found " ++ show (length defs) ++ " definition(s):" + mapM_ printDef defs + +runStats :: StatsOptions -> IO () +runStats options = do + let config = (defaultDbConfig (stDbPath options)) + { dbReadOnly = True + , dbCreate = False + } + withStorage config $ \(db :: RocksDB) -> do + props <- properties db + stats <- predicateStats db + putStrLn $ "Database: " ++ stDbPath options + putStrLn $ " Version: " ++ show (propVersion props) + putStrLn $ " First ID: " ++ show (propFirstId props) + putStrLn $ " Next ID: " ++ show (propFirstFreeId props) + putStrLn $ " Facts: " ++ show (propFactCount props) + putStrLn $ " Predicates: " ++ show (length stats) + +-- ── Display helpers ─────────────────────────────────────────────────────────── + +printDef :: DefinitionFact -> IO () +printDef d = putStrLn $ + " " ++ Text.unpack (defName d) ++ + " [" ++ Text.unpack (defModule d) ++ "]" ++ + " line " ++ show (posLine (spanStart (defSpan d))) + +printRef :: ReferenceFact -> IO () +printRef r = putStrLn $ + " " ++ Text.unpack (refName r) ++ + " [" ++ Text.unpack (refModule r) ++ "]" ++ + " line " ++ show (posLine (spanStart (refSpan r))) ++ + maybe "" (\t -> " -> " ++ Text.unpack t) (refTarget r) + +-- ── Main ────────────────────────────────────────────────────────────────────── + +main :: IO () +main = do + cmd <- execParser opts + result <- catch (run cmd >> return True) + (\e -> do + hPutStrLn stderr $ "Error: " ++ displayException (e :: SomeException) + return False) + if result + then return () + else exitFailure + +run :: Command -> IO () +run (Index options) = runIndex options +run (Query options) = runQuery options +run (Stats options) = runStats options diff --git a/haskell/src/Glean/FFI.hs b/haskell/src/Glean/FFI.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/FFI.hs @@ -0,0 +1,264 @@ +-- | Foreign function interface to the glean-hs Rust substrate. +-- +-- Binds the C-ABI functions exported by src/storage/rocksdb.rs. +-- The Rust library must be built before this module can link: +-- +-- @ +-- cargo build --release +-- cabal build +-- @ +-- +-- Error handling convention (matching Meta Glean): +-- Every function returns a CString error message. +-- Null pointer = success. +-- Non-null pointer = error message (must be freed via freeError). + +module Glean.FFI + ( -- * Cache + GleanCache + , newCache + , freeCache + , cacheCapacity + + -- * Container + , GleanContainer + , OpenMode (..) + , openContainer + + -- * Database + , GleanDatabase + , openDatabase + , freeDatabase + + -- * Backup/Restore + , restore + + -- * Fact storage + , store + , retrieve + , freeBytes + , getMeta + + -- * Error handling + , GleanError + , checkError + ) where + +import Control.Exception (throwIO, Exception) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BSU +import Foreign +import Foreign.C.String +import Foreign.C.Types + +-- ── Opaque types ────────────────────────────────────────────────────────────── + +-- | Opaque handle to a RocksDB block cache. +data CCache +-- | Opaque handle to a RocksDB container (database files on disk). +data CContainer +-- | Opaque handle to a logical Glean database. +data CDatabase + +-- | Type aliases for clarity at the Haskell level. +type GleanCache = ForeignPtr CCache +type GleanContainer = ForeignPtr CContainer +type GleanDatabase = ForeignPtr CDatabase + +-- ── Error handling ──────────────────────────────────────────────────────────── + +-- | An error returned by the Rust substrate. +newtype GleanError = GleanError String + deriving (Show) + +instance Exception GleanError + +-- | Free an error string returned by the Rust substrate. +foreign import ccall unsafe "glean_rocksdb_free_error" + c_free_error :: CString -> IO () + +-- | Check a C error string. Null = success; non-null = throw GleanError. +checkError :: CString -> IO () +checkError ptr + | ptr == nullPtr = return () + | otherwise = do + msg <- peekCString ptr + c_free_error ptr + throwIO (GleanError msg) + +-- ── Cache FFI ───────────────────────────────────────────────────────────────── + +foreign import ccall unsafe "glean_rocksdb_new_cache" + c_new_cache :: CSize -> Ptr (Ptr CCache) -> IO CString + +foreign import ccall unsafe "&glean_rocksdb_free_cache" + c_free_cache :: FinalizerPtr CCache + +foreign import ccall unsafe "glean_rocksdb_cache_capacity" + c_cache_capacity :: Ptr CCache -> IO CSize + +-- | Allocate a new RocksDB block cache of the given size in bytes. +newCache :: Int -> IO GleanCache +newCache size = + alloca $ \pptr -> do + err <- c_new_cache (fromIntegral size) pptr + checkError err + ptr <- peek pptr + newForeignPtr c_free_cache ptr + +-- | Free a cache (called automatically by GC via ForeignPtr finalizer). +freeCache :: GleanCache -> IO () +freeCache = finalizeForeignPtr + +-- | Return the capacity of a cache in bytes. +cacheCapacity :: GleanCache -> IO Int +cacheCapacity cache = + withForeignPtr cache $ \ptr -> + fromIntegral <$> c_cache_capacity ptr + +-- ── Container FFI ───────────────────────────────────────────────────────────── + +foreign import ccall safe "glean_rocksdb_container_open" + c_container_open + :: CString -- path + -> CInt -- mode (0=ReadOnly, 1=ReadWrite, 2=Create) + -> Word8 -- cache_index (CBool) + -> Ptr CCache -- cache (nullable) + -> Ptr (Ptr CContainer) + -> IO CString + +-- | How to open a RocksDB container. +data OpenMode + = ReadOnly + | ReadWrite + | Create + deriving (Show, Eq) + +openModeToInt :: OpenMode -> CInt +openModeToInt ReadOnly = 0 +openModeToInt ReadWrite = 1 +openModeToInt Create = 2 + +-- | Open or create a RocksDB container at the given path. +openContainer + :: FilePath + -> OpenMode + -> Maybe GleanCache -- ^ Optional block cache + -> IO GleanContainer +openContainer path mode mCache = + withCString path $ \cpath -> + alloca $ \pptr -> do + err <- case mCache of + Nothing -> + c_container_open cpath (openModeToInt mode) 0 nullPtr pptr + Just cache -> + withForeignPtr cache $ \cptr -> + c_container_open cpath (openModeToInt mode) 1 cptr pptr + checkError err + ptr <- peek pptr + newForeignPtr_ ptr -- no finalizer yet — container lifetime managed manually + +-- ── Database FFI ────────────────────────────────────────────────────────────── + +foreign import ccall safe "glean_rocksdb_container_open_database" + c_open_database + :: Ptr CContainer + -> Word64 -- start_id (Fid) + -> Word32 -- first_unit_id (UsetId) + -> Int64 -- version + -> Ptr (Ptr CDatabase) + -> IO CString + +foreign import ccall safe "&glean_rocksdb_database_free" + c_free_database :: FinalizerPtr CDatabase + +-- | Open a logical database within a container. +openDatabase + :: GleanContainer + -> Word64 -- ^ Starting fact ID (Fid::LOWEST = 1024) + -> Word32 -- ^ First unit ID + -> Int64 -- ^ Schema version + -> IO GleanDatabase +openDatabase container startId firstUnitId version = + withForeignPtr container $ \cptr -> + alloca $ \pptr -> do + err <- c_open_database cptr startId firstUnitId version pptr + checkError err + ptr <- peek pptr + newForeignPtr c_free_database ptr + +-- | Free a database handle. +freeDatabase :: GleanDatabase -> IO () +freeDatabase = finalizeForeignPtr + +-- ── Backup/Restore FFI ──────────────────────────────────────────────────────── + +foreign import ccall safe "glean_rocksdb_restore" + c_restore :: CString -> CString -> IO CString + +-- | Restore a database from source path to target path. +restore :: FilePath -> FilePath -> IO () +restore target source = + withCString target $ \ctarget -> + withCString source $ \csource -> do + err <- c_restore ctarget csource + checkError err + +-- ── Fact storage FFI ────────────────────────────────────────────────────────── + +foreign import ccall safe "glean_rocksdb_store" + c_store :: Ptr CDatabase -> Ptr Word8 -> CSize -> Word64 -> IO CString + +foreign import ccall safe "glean_rocksdb_retrieve" + c_retrieve :: Ptr CDatabase -> Ptr (Ptr Word8) -> Ptr CSize -> IO CString + +foreign import ccall unsafe "glean_rocksdb_free_bytes" + c_free_bytes :: Ptr Word8 -> CSize -> IO () + +-- | Store a serialized fact batch into the database. +-- fact_count is the exact number of facts in this batch. +store :: GleanDatabase -> ByteString -> Word64 -> IO () +store db bytes factCount = + withForeignPtr db $ \dbptr -> + BSU.unsafeUseAsCStringLen bytes $ \(ptr, len) -> do + err <- c_store dbptr (castPtr ptr) (fromIntegral len) factCount + checkError err + +-- | Retrieve serialized fact data from the database. +-- Returns Nothing if no facts are stored yet. +retrieve :: GleanDatabase -> IO (Maybe ByteString) +retrieve db = + withForeignPtr db $ \dbptr -> + alloca $ \pptr -> + alloca $ \plen -> do + err <- c_retrieve dbptr pptr plen + checkError err + ptr <- peek pptr + if ptr == nullPtr + then return Nothing + else do + len <- peek plen + bs <- BS.packCStringLen (castPtr ptr, fromIntegral len) + c_free_bytes ptr len + return (Just bs) + +-- | Free bytes allocated by retrieve (called internally). +freeBytes :: Ptr Word8 -> Int -> IO () +freeBytes ptr len = c_free_bytes ptr (fromIntegral len) + +-- ── Metadata FFI ────────────────────────────────────────────────────────────── + +foreign import ccall safe "glean_rocksdb_get_meta" + c_get_meta :: Ptr CDatabase -> CString -> Ptr Word64 -> IO CString + +-- | Read a u64 metadata value by key from the database. +-- Returns 0 if the key does not exist. +getMeta :: GleanDatabase -> String -> IO Word64 +getMeta db key = + withForeignPtr db $ \dbptr -> + withCString key $ \ckey -> + alloca $ \pval -> do + err <- c_get_meta dbptr ckey pval + checkError err + peek pval diff --git a/haskell/src/Glean/Indexer/HIE.hs b/haskell/src/Glean/Indexer/HIE.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/Indexer/HIE.hs @@ -0,0 +1,370 @@ +-- | HIE file indexer for glean-hs. +-- +-- Reads GHC HIE (Haskell Interface Extended) files and converts +-- the semantic information into Glean facts stored via 'Storage'. +-- +-- HIE files are generated by GHC when compiled with: +-- ghc -fwrite-ide-info -hiedir=.hie +-- or via cabal: +-- ghc-options: -fwrite-ide-info +-- +-- We use HIE files rather than parsing Haskell source because: +-- * GHC is the authoritative Haskell parser +-- * HIE files contain fully resolved types and names +-- * Zero maintenance burden as GHC evolves +-- * More information than source parsing can produce +-- +-- Reference implementation: Calligraphy library +-- https://hackage.haskell.org/package/calligraphy + +module Glean.Indexer.HIE + ( indexHieFile + , indexHieDirectory + , indexProject + , IndexConfig (..) + , defaultIndexConfig + , IndexResult (..) + , IndexStats (..) + ) where + +import Control.Exception (try, SomeException) +import Control.Monad (forM, forM_, when) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as Builder +import Data.IORef +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe, fromMaybe) +import qualified Data.Set as Set +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Word (Word64) +import System.Directory (listDirectory, doesFileExist, doesDirectoryExist) +import System.FilePath ((), takeExtension) + +-- GHC HIE file reading (GHC 9.12 API) +import GHC.Iface.Ext.Types + ( HieFile (..) + , HieASTs (..) + , HieAST (..) + , NodeInfo (..) + , SourcedNodeInfo (..) + , Identifier + , IdentifierDetails (..) + , ContextInfo (..) + + , getAsts + ) +import GHC.Iface.Ext.Binary (readHieFile, HieFileResult(..)) +import GHC.Types.Name.Cache (initNameCache) +import GHC.Types.Name (nameOccName, nameModule_maybe, occNameString) +import GHC.Types.SrcLoc + ( RealSrcSpan + , realSrcSpanStart, realSrcSpanEnd + , srcLocLine, srcLocCol + ) +import GHC.Unit.Module (moduleName, moduleNameString) + +import Glean.Indexer.Types +import Glean.Storage hiding (emptyStats) + +-- Configuration + +data IndexConfig = IndexConfig + { cfgHieDir :: FilePath + , cfgVerbose :: Bool + , cfgMaxFiles :: Maybe Int + } deriving (Show, Eq) + +defaultIndexConfig :: IndexConfig +defaultIndexConfig = IndexConfig + { cfgHieDir = ".hie" + , cfgVerbose = False + , cfgMaxFiles = Nothing + } + +-- Results + +data IndexStats = IndexStats + { statsFilesIndexed :: !Int + , statsDefsFound :: !Int + , statsRefsFound :: !Int + , statsModulesFound :: !Int + , statsImportsFound :: !Int + , statsErrors :: !Int + } deriving (Show, Eq) + +data IndexResult = IndexResult + { resultStats :: !IndexStats + , resultModules :: ![IndexedModule] + } deriving (Show, Eq) + +emptyStats :: IndexStats +emptyStats = IndexStats 0 0 0 0 0 0 + +-- HIE file reading + +indexHieFile :: FilePath -> IO (Maybe IndexedModule) +indexHieFile path = do + exists <- doesFileExist path + if not exists + then return Nothing + else do + result <- try (readHieFileRaw path) :: IO (Either SomeException HieFile) + case result of + Left _ -> return Nothing + Right hie -> return $ Just (extractFacts hie) + +readHieFileRaw :: FilePath -> IO HieFile +readHieFileRaw path = do + nameCache <- initNameCache 'a' [] + result <- readHieFile nameCache path + return (hie_file_result result) + +-- Fact extraction + +extractFacts :: HieFile -> IndexedModule +extractFacts hie = + let modName = Text.pack + $ moduleNameString + $ moduleName + $ hie_module hie + srcFile = SrcFile $ Text.pack $ hie_hs_file hie + modFact = ModuleFact { modName = modName, modFile = srcFile } + asts = Map.elems $ getAsts $ hie_asts hie + defs = concatMap (extractDefs modName srcFile) asts + refs = concatMap (extractRefs modName srcFile) asts + in IndexedModule + { idxModule = modFact + , idxDefinitions = defs + , idxReferences = refs + , idxImports = [] + } + +-- | Get merged identifiers from a SourcedNodeInfo (GHC 9.12). +-- SourcedNodeInfo is a Map NodeOrigin (NodeInfo a) in GHC 9.12. +getNodeIdentifiers :: SourcedNodeInfo a -> Map Identifier (IdentifierDetails a) +getNodeIdentifiers (SourcedNodeInfo nodeMap) = + Map.foldl' (\acc ni -> Map.unionWith mergeDetails acc (nodeIdentifiers ni)) + Map.empty + nodeMap + +mergeDetails :: IdentifierDetails a -> IdentifierDetails a -> IdentifierDetails a +mergeDetails d1 d2 = d1 + { identInfo = Set.union (identInfo d1) (identInfo d2) } + +extractDefs :: Text -> SrcFile -> HieAST a -> [DefinitionFact] +extractDefs modName srcFile node = + let glSpan = convertSpan srcFile (nodeSpan node) + idents = getNodeIdentifiers (sourcedNodeInfo node) + nodeDefs = mapMaybe (extractDef modName glSpan) (Map.toList idents) + children = concatMap (extractDefs modName srcFile) (nodeChildren node) + in nodeDefs ++ children + +extractDef :: Text -> SrcSpan -> (Identifier, IdentifierDetails a) + -> Maybe DefinitionFact +extractDef modName span (ident, details) = + case ident of + Left _ -> Nothing + Right name -> + if any isDefinition (Set.toList (identInfo details)) + then Just DefinitionFact + { defName = Text.pack $ occNameString $ nameOccName name + , defModule = modName + , defSpan = span + , defType = Nothing + } + else Nothing + +isDefinition :: ContextInfo -> Bool +isDefinition (ValBind _ _ _) = True +isDefinition (PatternBind _ _ _) = True +isDefinition (Decl _ _) = True +isDefinition TyDecl = True +isDefinition (ClassTyDecl _) = True +isDefinition _ = False + +extractRefs :: Text -> SrcFile -> HieAST a -> [ReferenceFact] +extractRefs modName srcFile node = + let glSpan = convertSpan srcFile (nodeSpan node) + idents = getNodeIdentifiers (sourcedNodeInfo node) + nodeRefs = mapMaybe (extractRef modName glSpan) (Map.toList idents) + children = concatMap (extractRefs modName srcFile) (nodeChildren node) + in nodeRefs ++ children + +extractRef :: Text -> SrcSpan -> (Identifier, IdentifierDetails a) + -> Maybe ReferenceFact +extractRef modName span (ident, details) = + case ident of + Left _ -> Nothing + Right name -> + if any isReference (Set.toList (identInfo details)) + then Just ReferenceFact + { refName = Text.pack $ occNameString $ nameOccName name + , refModule = modName + , refSpan = span + , refTarget = fmap (Text.pack . moduleNameString . moduleName) + $ nameModule_maybe name + } + else Nothing + +isReference :: ContextInfo -> Bool +isReference Use = True +isReference (IEThing _) = True +isReference _ = False + +convertSpan :: SrcFile -> RealSrcSpan -> SrcSpan +convertSpan file rss = SrcSpan + { spanFile = file + , spanStart = SrcPos + { posLine = srcLocLine $ realSrcSpanStart rss + , posCol = srcLocCol $ realSrcSpanStart rss + } + , spanEnd = SrcPos + { posLine = srcLocLine $ realSrcSpanEnd rss + , posCol = srcLocCol $ realSrcSpanEnd rss + } + } + +-- Directory indexing + +indexHieDirectory :: IndexConfig -> IO IndexResult +indexHieDirectory config = do + files <- findHieFiles (cfgHieDir config) + let files' = maybe files (`take` files) (cfgMaxFiles config) + when (cfgVerbose config) $ + putStrLn $ "Found " ++ show (length files') ++ " HIE files" + statsRef <- newIORef emptyStats + modulesRef <- newIORef [] + forM_ files' $ \f -> do + when (cfgVerbose config) $ putStrLn $ "Indexing: " ++ f + result <- indexHieFile f + case result of + Nothing -> modifyIORef' statsRef $ \s -> + s { statsErrors = statsErrors s + 1 } + Just m -> do + modifyIORef' statsRef $ \s -> s + { statsFilesIndexed = statsFilesIndexed s + 1 + , statsDefsFound = statsDefsFound s + length (idxDefinitions m) + , statsRefsFound = statsRefsFound s + length (idxReferences m) + , statsModulesFound = statsModulesFound s + 1 + , statsImportsFound = statsImportsFound s + length (idxImports m) + } + modifyIORef' modulesRef (m :) + stats <- readIORef statsRef + modules <- readIORef modulesRef + return IndexResult + { resultStats = stats + , resultModules = reverse modules + } + +findHieFiles :: FilePath -> IO [FilePath] +findHieFiles dir = do + exists <- doesDirectoryExist dir + if not exists + then return [] + else do + entries <- listDirectory dir + results <- forM entries $ \entry -> do + let path = dir entry + isDir <- doesDirectoryExist path + isFile <- doesFileExist path + if isDir + then findHieFiles path + else if isFile && takeExtension path == ".hie" + then return [path] + else return [] + return $ concat results + +-- Project indexing + +indexProject :: Storage s => s -> IndexConfig -> IO IndexStats +indexProject db config = do + result <- indexHieDirectory config + when (cfgVerbose config) $ do + let s = resultStats result + putStrLn $ "Indexing complete:" + putStrLn $ " Files: " ++ show (statsFilesIndexed s) + putStrLn $ " Definitions: " ++ show (statsDefsFound s) + putStrLn $ " References: " ++ show (statsRefsFound s) + putStrLn $ " Modules: " ++ show (statsModulesFound s) + putStrLn $ " Errors: " ++ show (statsErrors s) + forM_ (resultModules result) $ \m -> + Glean.Storage.store db (serializeModule m) + return (resultStats result) + +-- Serialization + +serializeModule :: IndexedModule -> FactBatch +serializeModule m = + let defBytes = foldMap serializeDef (idxDefinitions m) + refBytes = foldMap serializeRef (idxReferences m) + modBytes = serializeMod (idxModule m) + impBytes = foldMap serializeImp (idxImports m) + allBytes = Builder.toLazyByteString + $ defBytes <> refBytes <> modBytes <> impBytes + count = length (idxDefinitions m) + + length (idxReferences m) + + 1 + + length (idxImports m) + in FactBatch + { batchData = BS.toStrict allBytes + , batchFirstId = 1024 + , batchCount = count + , batchPredicates = Map.fromList + [ (pidDefinition, length (idxDefinitions m)) + , (pidReference, length (idxReferences m)) + , (pidModule, 1) + , (pidImport, length (idxImports m)) + ] + } + +-- | Wrap a fact body with pid + length header. +-- Format: word64LE(pid) + word32LE(body_len) + body_bytes +-- This allows the deserializer to find fact boundaries. +wrapFact :: Word64 -> Builder.Builder -> Builder.Builder +wrapFact pid body = + let bodyBytes = BS.toStrict $ Builder.toLazyByteString body + in Builder.word64LE pid <> + Builder.word32LE (fromIntegral (BS.length bodyBytes)) <> + Builder.byteString bodyBytes + +serializeDef :: DefinitionFact -> Builder.Builder +serializeDef def = wrapFact pidDefinition $ + encodeText (defName def) <> + encodeText (defModule def) <> + encodeSpan (defSpan def) + +serializeRef :: ReferenceFact -> Builder.Builder +serializeRef ref = wrapFact pidReference $ + encodeText (refName ref) <> + encodeText (refModule ref) <> + encodeSpan (refSpan ref) <> + encodeText (fromMaybe Text.empty (refTarget ref)) + +serializeMod :: ModuleFact -> Builder.Builder +serializeMod m = wrapFact pidModule $ + encodeText (modName m) <> + encodeText (srcFilePath (modFile m)) + +serializeImp :: ImportFact -> Builder.Builder +serializeImp imp = wrapFact pidImport $ + encodeText (impFrom imp) <> + encodeText (impTarget imp) <> + Builder.word8 (if impQualified imp then 1 else 0) <> + encodeText (fromMaybe Text.empty (impAlias imp)) + +encodeText :: Text -> Builder.Builder +encodeText t = + let bs = Text.encodeUtf8 t + in Builder.word32LE (fromIntegral (BS.length bs)) <> + Builder.byteString bs + +encodeSpan :: SrcSpan -> Builder.Builder +encodeSpan span = + encodeText (srcFilePath (spanFile span)) <> + Builder.word32LE (fromIntegral (posLine (spanStart span))) <> + Builder.word32LE (fromIntegral (posCol (spanStart span))) <> + Builder.word32LE (fromIntegral (posLine (spanEnd span))) <> + Builder.word32LE (fromIntegral (posCol (spanEnd span))) diff --git a/haskell/src/Glean/Indexer/Types.hs b/haskell/src/Glean/Indexer/Types.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/Indexer/Types.hs @@ -0,0 +1,120 @@ +-- | Types for the glean-hs HIE indexer. +-- +-- These types represent the facts we extract from GHC HIE files +-- and store in the Glean database. + +module Glean.Indexer.Types + ( -- * Source locations + SrcFile (..) + , SrcSpan (..) + , SrcPos (..) + + -- * Code facts + , DefinitionFact (..) + , ReferenceFact (..) + , ModuleFact (..) + , ImportFact (..) + + -- * Indexed module + , IndexedModule (..) + , emptyIndexedModule + + -- * Predicate IDs (must match Angle schema) + , pidDefinition + , pidReference + , pidModule + , pidImport + ) where + +import Data.Text (Text) +import Data.Word (Word64) + +-- ── Source locations ────────────────────────────────────────────────────────── + +-- | A source file path. +newtype SrcFile = SrcFile { srcFilePath :: Text } + deriving (Show, Eq, Ord) + +-- | A position in a source file (1-indexed). +data SrcPos = SrcPos + { posLine :: !Int + , posCol :: !Int + } deriving (Show, Eq, Ord) + +-- | A span in a source file. +data SrcSpan = SrcSpan + { spanFile :: !SrcFile + , spanStart :: !SrcPos + , spanEnd :: !SrcPos + } deriving (Show, Eq, Ord) + +-- ── Code facts ──────────────────────────────────────────────────────────────── + +-- | A definition fact: a name defined at a location. +data DefinitionFact = DefinitionFact + { defName :: !Text -- ^ The defined name (e.g. "validateCDTCode") + , defModule :: !Text -- ^ The module it belongs to + , defSpan :: !SrcSpan -- ^ Where it's defined + , defType :: !(Maybe Text) -- ^ Type signature if available + } deriving (Show, Eq) + +-- | A reference fact: a name used at a location. +data ReferenceFact = ReferenceFact + { refName :: !Text -- ^ The referenced name + , refModule :: !Text -- ^ The module containing the reference + , refSpan :: !SrcSpan -- ^ Where it's referenced + , refTarget :: !(Maybe Text) -- ^ The module where it's defined + } deriving (Show, Eq) + +-- | A module fact: a Haskell module. +data ModuleFact = ModuleFact + { modName :: !Text -- ^ Module name (e.g. "SeidoClaims.Validation") + , modFile :: !SrcFile -- ^ Source file + } deriving (Show, Eq) + +-- | An import fact: a module importing another. +data ImportFact = ImportFact + { impFrom :: !Text -- ^ Importing module + , impTarget :: !Text -- ^ Imported module + , impQualified :: !Bool -- ^ Is it a qualified import? + , impAlias :: !(Maybe Text) -- ^ Import alias if any + } deriving (Show, Eq) + +-- ── Indexed module ──────────────────────────────────────────────────────────── + +-- | All facts extracted from a single HIE file. +data IndexedModule = IndexedModule + { idxModule :: !ModuleFact + , idxDefinitions :: ![DefinitionFact] + , idxReferences :: ![ReferenceFact] + , idxImports :: ![ImportFact] + } deriving (Show, Eq) + +-- | An empty indexed module. +emptyIndexedModule :: ModuleFact -> IndexedModule +emptyIndexedModule m = IndexedModule + { idxModule = m + , idxDefinitions = [] + , idxReferences = [] + , idxImports = [] + } + +-- ── Predicate IDs ───────────────────────────────────────────────────────────── +-- These must match the Angle schema definitions. +-- Using sequential IDs starting from Fid::LOWEST (1024). + +-- | Predicate ID for definition facts. +pidDefinition :: Word64 +pidDefinition = 1 + +-- | Predicate ID for reference facts. +pidReference :: Word64 +pidReference = 2 + +-- | Predicate ID for module facts. +pidModule :: Word64 +pidModule = 3 + +-- | Predicate ID for import facts. +pidImport :: Word64 +pidImport = 4 diff --git a/haskell/src/Glean/Query.hs b/haskell/src/Glean/Query.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/Query.hs @@ -0,0 +1,319 @@ +-- | Direct query layer for glean-hs. +-- +-- Phase 13, Step 1: batch scanning queries. +-- Correct but O(n) — sufficient for small databases. +-- +-- When indexing large projects (e.g. SeidoClaims, 50K+ facts), +-- migrate storage to composite keys (encode(pid) + fact_key) +-- for O(1) point lookups. The interface here stays the same. +-- +-- Usage: +-- @ +-- import Glean.Query +-- +-- defs <- findDefinitions db "validateCDTCode" +-- refs <- findReferences db "validateCDTCode" +-- mods <- findByModule db "SeidoClaims.Validation" +-- @ + +module Glean.Query + ( -- * Definition queries + findDefinitions + , findDefinition + + -- * Reference queries + , findReferences + + -- * Module queries + , findByModule + , findModules + + -- * General queries + , findFacts + , QueryResult (..) + ) where + +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Maybe (mapMaybe) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Data.Word (Word32, Word64) + +import Glean.Storage +import Glean.Indexer.Types + +-- ── Query result type ───────────────────────────────────────────────────────── + +-- | A query result — a fact matching the query criteria. +data QueryResult + = DefinitionResult DefinitionFact + | ReferenceResult ReferenceFact + | ModuleResult ModuleFact + | ImportResult ImportFact + deriving (Show, Eq) + +-- ── Public query API ────────────────────────────────────────────────────────── + +-- | Find all definitions of a given name across all modules. +-- O(n) — scans all stored batches. +findDefinitions :: Storage s => s -> Text -> IO [DefinitionFact] +findDefinitions db name = do + facts <- loadAllFacts db + return $ filter (\d -> defName d == name) + $ mapMaybe toDefinition facts + +-- | Find the first definition of a given name. +-- Returns Nothing if not found. +findDefinition :: Storage s => s -> Text -> IO (Maybe DefinitionFact) +findDefinition db name = do + defs <- findDefinitions db name + return $ case defs of + [] -> Nothing + (d:_) -> Just d + +-- | Find all references to a given name. +-- O(n) — scans all stored batches. +findReferences :: Storage s => s -> Text -> IO [ReferenceFact] +findReferences db name = do + facts <- loadAllFacts db + return $ filter (\r -> refName r == name) + $ mapMaybe toReference facts + +-- | Find all facts (definitions, references) in a given module. +-- O(n) — scans all stored batches. +findByModule :: Storage s => s -> Text -> IO [QueryResult] +findByModule db moduleName = do + facts <- loadAllFacts db + return $ mapMaybe (matchModule moduleName) facts + +-- | Find all indexed modules. +-- O(n) — scans all stored batches. +findModules :: Storage s => s -> IO [ModuleFact] +findModules db = do + facts <- loadAllFacts db + return $ mapMaybe toModule facts + +-- | General fact query by predicate ID and optional name filter. +findFacts :: Storage s => s -> Word64 -> Maybe Text -> IO [QueryResult] +findFacts db pid mName = do + facts <- loadAllFacts db + let matching = filter (matchesPid pid) facts + let filtered = case mName of + Nothing -> matching + Just name -> filter (matchesName name) matching + return $ mapMaybe toQueryResult filtered + +-- ── Batch loading ───────────────────────────────────────────────────────────── + +-- | Load and deserialize all facts from the database. +-- This is the O(n) core — reads all batches and deserializes them. +-- TODO Phase 13 Step 2: replace with composite key point lookups. +loadAllFacts :: Storage s => s -> IO [RawFact] +loadAllFacts db = do + result <- retrieve db + case result of + Nothing -> do + return [] + Just batch -> do + let facts = deserializeBatch batch + return facts + +-- ── Raw fact type (internal) ────────────────────────────────────────────────── + +-- | A deserialized raw fact from the database. +data RawFact = RawFact + { rawPid :: !Word64 + , rawData :: !ByteString + } deriving (Show, Eq) + +-- ── Deserialization ─────────────────────────────────────────────────────────── + +-- | Deserialize a FactBatch into raw facts. +deserializeBatch :: FactBatch -> [RawFact] +deserializeBatch batch = go (batchData batch) + where + go bytes + | BS.null bytes = [] + | otherwise = + case readRawFact bytes of + Nothing -> [] + Just (fact, rest) -> fact : go rest + +-- | Read one raw fact from a byte string. +-- Returns the fact and remaining bytes, or Nothing on parse failure. +readRawFact :: ByteString -> Maybe (RawFact, ByteString) +readRawFact bytes = do + (pid, r1) <- readWord64LE bytes + (dlen, r2) <- readWord32LE r1 + let dlen' = fromIntegral dlen + if BS.length r2 < dlen' + then Nothing + else Just (RawFact pid (BS.take dlen' r2), BS.drop dlen' r2) + +-- ── Binary reading helpers ──────────────────────────────────────────────────── + +readWord64LE :: ByteString -> Maybe (Word64, ByteString) +readWord64LE bs + | BS.length bs < 8 = Nothing + | otherwise = + let (w, rest) = BS.splitAt 8 bs + val = foldr (\(i, b) acc -> acc + fromIntegral b * (256 :: Word64)^(i :: Int)) + 0 + (zip [0..7] (BS.unpack w)) + in Just (val, rest) + +readWord32LE :: ByteString -> Maybe (Word32, ByteString) +readWord32LE bs + | BS.length bs < 4 = Nothing + | otherwise = + let (w, rest) = BS.splitAt 4 bs + val = foldr (\(i, b) acc -> acc + fromIntegral b * (256 :: Word32)^(i :: Int)) + 0 + (zip [0..3] (BS.unpack w)) + in Just (val, rest) + +readTextLE :: ByteString -> Maybe (Text, ByteString) +readTextLE bs = do + (len, rest) <- readWord32LE bs + let len' = fromIntegral len + if BS.length rest < len' + then Nothing + else Just ( Text.decodeUtf8 (BS.take len' rest) + , BS.drop len' rest ) + +-- ── Fact interpretation ─────────────────────────────────────────────────────── + +-- | Try to interpret a raw fact as a DefinitionFact. +toDefinition :: RawFact -> Maybe DefinitionFact +toDefinition fact + | rawPid fact /= pidDefinition = Nothing + | otherwise = parseDefinition (rawData fact) + +-- | Try to interpret a raw fact as a ReferenceFact. +toReference :: RawFact -> Maybe ReferenceFact +toReference fact + | rawPid fact /= pidReference = Nothing + | otherwise = parseReference (rawData fact) + +-- | Try to interpret a raw fact as a ModuleFact. +toModule :: RawFact -> Maybe ModuleFact +toModule fact + | rawPid fact /= pidModule = Nothing + | otherwise = parseModule (rawData fact) + +-- | Convert a raw fact to a QueryResult. +toQueryResult :: RawFact -> Maybe QueryResult +toQueryResult fact + | rawPid fact == pidDefinition = + DefinitionResult <$> parseDefinition (rawData fact) + | rawPid fact == pidReference = + ReferenceResult <$> parseReference (rawData fact) + | rawPid fact == pidModule = + ModuleResult <$> parseModule (rawData fact) + | rawPid fact == pidImport = + ImportResult <$> parseImport (rawData fact) + | otherwise = Nothing + +-- ── Fact parsers ────────────────────────────────────────────────────────────── + +-- | Parse a DefinitionFact from raw bytes. +-- Format matches serializeDef in HIE.hs: +-- word32(name_len) + name_bytes +-- word32(module_len) + module_bytes +-- span bytes +parseDefinition :: ByteString -> Maybe DefinitionFact +parseDefinition bs = do + (name, r1) <- readTextLE bs + (modName, r2) <- readTextLE r1 + span_ <- parseSpan r2 + return DefinitionFact + { defName = name + , defModule = modName + , defSpan = fst span_ + , defType = Nothing + } + +-- | Parse a ReferenceFact from raw bytes. +parseReference :: ByteString -> Maybe ReferenceFact +parseReference bs = do + (name, r1) <- readTextLE bs + (modName, r2) <- readTextLE r1 + (span_, r3) <- parseSpan r2 + (target, _) <- readTextLE r3 + return ReferenceFact + { refName = name + , refModule = modName + , refSpan = span_ + , refTarget = if Text.null target then Nothing else Just target + } + +-- | Parse a ModuleFact from raw bytes. +parseModule :: ByteString -> Maybe ModuleFact +parseModule bs = do + (name, r1) <- readTextLE bs + (file, _) <- readTextLE r1 + return ModuleFact + { modName = name + , modFile = SrcFile file + } + +-- | Parse an ImportFact from raw bytes. +parseImport :: ByteString -> Maybe ImportFact +parseImport bs = do + (from, r1) <- readTextLE bs + (target, r2) <- readTextLE r1 + (qual, r3) <- readQual r2 + (alias, _) <- readTextLE r3 + return ImportFact + { impFrom = from + , impTarget = target + , impQualified = qual + , impAlias = if Text.null alias then Nothing else Just alias + } + +-- | Parse a SrcSpan from bytes. +-- Format matches encodeSpan in HIE.hs. +parseSpan :: ByteString -> Maybe (SrcSpan, ByteString) +parseSpan bs = do + (file, r1) <- readTextLE bs + (startLine, r2) <- readWord32LE r1 + (startCol, r3) <- readWord32LE r2 + (endLine, r4) <- readWord32LE r3 + (endCol, r5) <- readWord32LE r4 + return ( SrcSpan + { spanFile = SrcFile file + , spanStart = SrcPos (fromIntegral startLine) + (fromIntegral startCol) + , spanEnd = SrcPos (fromIntegral endLine) + (fromIntegral endCol) + } + , r5 + ) + +-- | Read a bool (Word8) as qualified flag. +readQual :: ByteString -> Maybe (Bool, ByteString) +readQual bs + | BS.null bs = Nothing + | otherwise = Just (BS.head bs /= 0, BS.tail bs) + +-- ── Filter helpers ──────────────────────────────────────────────────────────── + +matchesPid :: Word64 -> RawFact -> Bool +matchesPid pid fact = rawPid fact == pid + +matchesName :: Text -> RawFact -> Bool +matchesName name fact = + case toQueryResult fact of + Just (DefinitionResult d) -> defName d == name + Just (ReferenceResult r) -> refName r == name + _ -> False + +matchModule :: Text -> RawFact -> Maybe QueryResult +matchModule mn fact = + case toQueryResult fact of + Just r@(DefinitionResult d) | defModule d == mn -> Just r + Just r@(ReferenceResult r') | refModule r' == mn -> Just r + Just r@(ModuleResult m) | modName m == mn -> Just r + _ -> Nothing diff --git a/haskell/src/Glean/RocksDB.hs b/haskell/src/Glean/RocksDB.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/RocksDB.hs @@ -0,0 +1,205 @@ +-- | RocksDB storage backend for glean-hs. +-- +-- Implements the 'Storage' typeclass using our Rust substrate +-- via the FFI bindings in "Glean.FFI". +-- +-- This module replaces Meta Glean's RocksDB.hs, which depends on +-- Meta-internal packages (Util.FFI, Util.Log, ServiceData). +-- Our implementation has zero Meta internal dependencies. +-- +-- Usage: +-- @ +-- import Glean.RocksDB (RocksDB) +-- import Glean.Storage +-- +-- withStorage (defaultDbConfig "\/tmp\/mydb") $ \(db :: RocksDB) -> do +-- store db myBatch +-- facts <- retrieve db +-- @ + +module Glean.RocksDB + ( RocksDB + , rocksDbOpen + , rocksDbClose + ) where + +import Control.Exception (throwIO, catch, SomeException) +import qualified Data.ByteString as BS +import Data.IORef +import qualified Data.Map.Strict as Map +import qualified Data.Text as Text + +import Glean.FFI +import Glean.Storage + +-- ── RocksDB handle ──────────────────────────────────────────────────────────── + +-- | A RocksDB-backed Glean database. +-- Wraps the Rust substrate via FFI. +data RocksDB = RocksDB + { rocksContainer :: !GleanContainer + -- ^ The RocksDB container (database files on disk). + , rocksDatabase :: !GleanDatabase + -- ^ The logical Glean database within the container. + , rocksConfig :: !DbConfig + -- ^ Configuration used to open this database. + , rocksProps :: !(IORef DbProperties) + -- ^ Mutable database properties (fact count etc.). + , rocksClosed :: !(IORef Bool) + -- ^ True if this database has been closed. + } + +-- ── Smart constructors ──────────────────────────────────────────────────────── + +-- | Open a RocksDB database directly. +-- Prefer 'withStorage' or 'open' (the Storage instance method). +rocksDbOpen :: DbConfig -> IO RocksDB +rocksDbOpen config = do + -- Allocate block cache + cache <- newCache (dbCacheSize config) + + -- Determine open mode + let mode + | dbReadOnly config = ReadOnly + | dbCreate config = Create + | otherwise = ReadWrite + + -- Open the container (RocksDB instance) + container <- openContainer (dbPath config) mode (Just cache) + `catch` \(e :: SomeException) -> + throwIO $ StorageOpenFailed + (Text.pack $ "Failed to open container: " ++ show e) + + -- Open the logical database within the container + db <- openDatabase + container + (dbStartId config) + 1 -- first_unit_id (default) + (dbVersion config) + `catch` \(e :: SomeException) -> + throwIO $ StorageOpenFailed + (Text.pack $ "Failed to open database: " ++ show e) + + -- Read persisted metadata from RocksDB + factCount <- Glean.FFI.getMeta db "meta:fact_count" + _batchCount <- Glean.FFI.getMeta db "meta:batch_count" + + -- Initialize mutable state from persisted values + propsRef <- newIORef $ DbProperties + { propVersion = dbVersion config + , propFirstId = dbStartId config + , propFirstFreeId = dbStartId config + factCount + , propFactCount = fromIntegral factCount + } + closedRef <- newIORef False + + return RocksDB + { rocksContainer = container + , rocksDatabase = db + , rocksConfig = config + , rocksProps = propsRef + , rocksClosed = closedRef + } + +-- | Close a RocksDB database. +rocksDbClose :: RocksDB -> IO () +rocksDbClose rdb = do + closed <- readIORef (rocksClosed rdb) + if closed + then return () -- idempotent close + else do + writeIORef (rocksClosed rdb) True + freeDatabase (rocksDatabase rdb) + -- Container is freed by GC via ForeignPtr finalizer + +-- ── Storage instance ────────────────────────────────────────────────────────── + +instance Storage RocksDB where + + open = rocksDbOpen + close = rocksDbClose + + store rdb batch = do + checkNotClosed rdb + let bytes = batchData batch + if BS.null bytes + then return () -- nothing to store + else do + Glean.FFI.store (rocksDatabase rdb) bytes + (fromIntegral (batchCount batch)) + `catch` \(e :: SomeException) -> + throwIO $ StorageWriteFailed + (Text.pack $ "store failed: " ++ show e) + -- Update properties + modifyIORef' (rocksProps rdb) $ \props -> props + { propFirstFreeId = propFirstFreeId props + + fromIntegral (batchCount batch) + , propFactCount = propFactCount props + batchCount batch + } + + retrieve rdb = do + checkNotClosed rdb + result <- Glean.FFI.retrieve (rocksDatabase rdb) + `catch` \(e :: SomeException) -> + throwIO $ StorageReadFailed + (Text.pack $ "retrieve failed: " ++ show e) + case result of + Nothing -> return Nothing + Just bytes -> do + props <- readIORef (rocksProps rdb) + return $ Just $ FactBatch + { batchData = bytes + , batchFirstId = propFirstId props + , batchCount = propFactCount props + , batchPredicates = Map.empty -- populated by indexer + } + + commit rdb = do + checkNotClosed rdb + -- RocksDB auto-commits writes + -- Explicit flush for durability guarantee + flush rdb + + flush rdb = do + checkNotClosed rdb + -- Flush is handled at the RocksDB level + -- No direct FFI call needed for basic operation + return () + + optimize rdb = do + checkNotClosed rdb + -- RocksDB compaction — deferred to Phase 10 (cache/optimize) + return () + + predicateStats rdb = do + checkNotClosed rdb + props <- readIORef (rocksProps rdb) + -- Detailed per-predicate stats require index scan + -- Basic implementation: return aggregate stats + return $ Map.singleton 0 $ PredicateStats + { statsCount = propFactCount props + , statsFirstId = propFirstId props + , statsLastId = propFirstFreeId props + } + + properties rdb = do + checkNotClosed rdb + readIORef (rocksProps rdb) + + backup rdb targetPath = do + checkNotClosed rdb + Glean.FFI.restore targetPath (dbPath (rocksConfig rdb)) + `catch` \(e :: SomeException) -> + throwIO $ StorageWriteFailed + (Text.pack $ "backup failed: " ++ show e) + +-- ── Internal helpers ────────────────────────────────────────────────────────── + +-- | Throw if the database has been closed. +checkNotClosed :: RocksDB -> IO () +checkNotClosed rdb = do + closed <- readIORef (rocksClosed rdb) + if closed + then throwIO $ StorageCloseFailed + (Text.pack "Operation on closed database") + else return () diff --git a/haskell/src/Glean/Storage.hs b/haskell/src/Glean/Storage.hs new file mode 100644 --- /dev/null +++ b/haskell/src/Glean/Storage.hs @@ -0,0 +1,225 @@ +-- | Storage typeclass for glean-hs. +-- +-- A clean, minimal reimplementation of Glean's Storage abstraction. +-- No Meta internal dependencies (no ODS, ServiceData, Util.FFI). +-- +-- The Storage typeclass defines the interface between the Glean +-- Haskell layer and the underlying database backend (RocksDB). +-- +-- Implementations: +-- Glean.RocksDB — production storage via Rust substrate +-- Glean.Memory — in-memory storage for testing (future) + +module Glean.Storage + ( -- * Storage typeclass + Storage (..) + + -- * Database configuration + , DbConfig (..) + , defaultDbConfig + + -- * Fact batch + , FactBatch (..) + , emptyBatch + , batchSize + + -- * Predicate statistics + , PredicateStats (..) + , emptyStats + + -- * Database properties + , DbProperties (..) + + -- * Errors + , StorageError (..) + + -- * Utilities + , withStorage + ) where + +import Control.Exception (Exception, bracket) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Int (Int64) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Text (Text) +import Data.Word (Word64) + +-- ── Errors ──────────────────────────────────────────────────────────────────── + +-- | Errors that can occur during storage operations. +data StorageError + = StorageOpenFailed Text -- ^ Failed to open database + | StorageWriteFailed Text -- ^ Failed to write facts + | StorageReadFailed Text -- ^ Failed to read facts + | StorageCloseFailed Text -- ^ Failed to close database + | StorageCorrupted Text -- ^ Database corruption detected + | StorageVersionMismatch Int64 Int64 + -- ^ Schema version mismatch (expected, actual) + deriving (Show) + +instance Exception StorageError + +-- ── Configuration ───────────────────────────────────────────────────────────── + +-- | Configuration for opening a database. +data DbConfig = DbConfig + { dbPath :: FilePath + -- ^ Path to the database directory on disk. + , dbReadOnly :: Bool + -- ^ Open in read-only mode (no writes allowed). + , dbCreate :: Bool + -- ^ Create the database if it doesn't exist. + , dbCacheSize :: Int + -- ^ RocksDB block cache size in bytes (default: 128MB). + , dbStartId :: Word64 + -- ^ Starting fact ID. Use 1024 (Fid::LOWEST) for new databases. + , dbVersion :: Int64 + -- ^ Schema version number. + } deriving (Show, Eq) + +-- | Sensible defaults for a new read-write database. +defaultDbConfig :: FilePath -> DbConfig +defaultDbConfig path = DbConfig + { dbPath = path + , dbReadOnly = False + , dbCreate = True + , dbCacheSize = 128 * 1024 * 1024 -- 128MB + , dbStartId = 1024 -- Fid::LOWEST + , dbVersion = 1 + } + +-- ── Fact batch ──────────────────────────────────────────────────────────────── + +-- | A batch of serialized facts ready to store. +-- Facts are encoded using Glean's binary format (nat.rs, binary.rs). +data FactBatch = FactBatch + { batchData :: !ByteString + -- ^ Binary-encoded fact data. + , batchFirstId :: !Word64 + -- ^ The fact ID of the first fact in this batch. + , batchCount :: !Int + -- ^ Number of facts in this batch. + , batchPredicates :: !(Map Word64 Int) + -- ^ Map from predicate ID (Pid) to count of facts for that predicate. + } deriving (Show, Eq) + +-- | An empty fact batch. +emptyBatch :: Word64 -> FactBatch +emptyBatch firstId = FactBatch + { batchData = BS.empty + , batchFirstId = firstId + , batchCount = 0 + , batchPredicates = Map.empty + } + +-- | Total number of facts in a batch. +batchSize :: FactBatch -> Int +batchSize = batchCount + +-- ── Predicate statistics ────────────────────────────────────────────────────── + +-- | Statistics for a single predicate. +data PredicateStats = PredicateStats + { statsCount :: !Int + -- ^ Number of facts for this predicate. + , statsFirstId :: !Word64 + -- ^ First fact ID for this predicate. + , statsLastId :: !Word64 + -- ^ Last fact ID for this predicate. + } deriving (Show, Eq) + +-- | Empty predicate statistics. +emptyStats :: PredicateStats +emptyStats = PredicateStats + { statsCount = 0 + , statsFirstId = 0 + , statsLastId = 0 + } + +-- ── Database properties ─────────────────────────────────────────────────────── + +-- | Properties of an open database. +data DbProperties = DbProperties + { propVersion :: !Int64 + -- ^ Schema version number. + , propFirstId :: !Word64 + -- ^ First fact ID in the database. + , propFirstFreeId :: !Word64 + -- ^ Next available fact ID. + , propFactCount :: !Int + -- ^ Total number of facts stored. + } deriving (Show, Eq) + +-- ── Storage typeclass ───────────────────────────────────────────────────────── + +-- | Abstract storage backend for a Glean database. +-- +-- All operations are in IO and may throw 'StorageError'. +-- +-- Minimal complete definition: 'open', 'close', 'store', 'retrieve'. +class Storage s where + + -- | Open a database with the given configuration. + -- Throws 'StorageOpenFailed' if the database cannot be opened. + open :: DbConfig -> IO s + + -- | Close a database, flushing any pending writes. + -- Throws 'StorageCloseFailed' if close fails. + close :: s -> IO () + + -- | Store a batch of facts. + -- Throws 'StorageWriteFailed' if the write fails. + store :: s -> FactBatch -> IO () + + -- | Retrieve all stored facts. + -- Returns Nothing if no facts have been stored yet. + -- Throws 'StorageReadFailed' if the read fails. + retrieve :: s -> IO (Maybe FactBatch) + + -- | Commit pending writes to durable storage. + -- Default implementation: no-op (some backends auto-commit). + commit :: s -> IO () + commit _ = return () + + -- | Get statistics for all predicates. + predicateStats :: s -> IO (Map Word64 PredicateStats) + predicateStats _ = return Map.empty + + -- | Get database properties. + properties :: s -> IO DbProperties + properties _ = return $ DbProperties + { propVersion = 1 + , propFirstId = 1024 + , propFirstFreeId = 1024 + , propFactCount = 0 + } + + -- | Optimize the database (compact, etc.). + -- Default implementation: no-op. + optimize :: s -> IO () + optimize _ = return () + + -- | Flush in-memory data to disk. + -- Default implementation: no-op. + flush :: s -> IO () + flush _ = return () + + -- | Create a backup of the database at the given path. + backup :: s -> FilePath -> IO () + backup _ _ = return () + +-- ── Utility ─────────────────────────────────────────────────────────────────── + +-- | Open a database, run an action, and close it safely. +-- Ensures 'close' is called even if the action throws. +-- +-- Example: +-- @ +-- withStorage (defaultDbConfig "\/tmp\/mydb") $ \db -> do +-- store db myBatch +-- retrieve db +-- @ +withStorage :: Storage s => DbConfig -> (s -> IO a) -> IO a +withStorage config = bracket (open config) close diff --git a/haskell/test/Spec.hs b/haskell/test/Spec.hs new file mode 100644 --- /dev/null +++ b/haskell/test/Spec.hs @@ -0,0 +1,12 @@ +module Main (main) where + +import Test.Hspec +import qualified Test.FFI +import qualified Test.Storage +import qualified Test.Indexer + +main :: IO () +main = hspec $ do + Test.FFI.spec + Test.Storage.spec + Test.Indexer.spec diff --git a/haskell/test/Test/FFI.hs b/haskell/test/Test/FFI.hs new file mode 100644 --- /dev/null +++ b/haskell/test/Test/FFI.hs @@ -0,0 +1,24 @@ +module Test.FFI (spec) where + +import Test.Hspec +import System.IO.Temp (withSystemTempDirectory) +import Glean.FFI +import Glean.Storage +import Glean.RocksDB (RocksDB) + +spec :: Spec +spec = describe "Glean.FFI" $ do + + it "can allocate and free a cache" $ do + cache <- newCache (8 * 1024 * 1024) + cap <- cacheCapacity cache + cap `shouldBe` (8 * 1024 * 1024) + freeCache cache + + it "can open and close a database" $ do + withSystemTempDirectory "glean-test" $ \dir -> do + let config = defaultDbConfig dir + withStorage config $ \(db :: RocksDB) -> do + props <- properties db + propVersion props `shouldBe` 1 + propFirstId props `shouldBe` 1024 diff --git a/haskell/test/Test/Indexer.hs b/haskell/test/Test/Indexer.hs new file mode 100644 --- /dev/null +++ b/haskell/test/Test/Indexer.hs @@ -0,0 +1,28 @@ +module Test.Indexer (spec) where + +import Test.Hspec +import System.IO.Temp (withSystemTempDirectory) +import System.FilePath (()) +import Glean.Indexer.HIE +import Glean.Indexer.Types +import Glean.Storage +import Glean.RocksDB (RocksDB) + +spec :: Spec +spec = describe "Glean.Indexer.HIE" $ do + + it "returns empty result for missing hie directory" $ do + let config = defaultIndexConfig { cfgHieDir = "/nonexistent/.hie" } + result <- indexHieDirectory config + statsFilesIndexed (resultStats result) `shouldBe` 0 + statsErrors (resultStats result) `shouldBe` 0 + + it "indexProject handles empty hie directory gracefully" $ do + withSystemTempDirectory "glean-test" $ \dir -> do + let dbConfig = defaultDbConfig dir + let idxConfig = defaultIndexConfig + { cfgHieDir = dir ".hie" } + withStorage dbConfig $ \(db :: RocksDB) -> do + stats <- indexProject db idxConfig + statsFilesIndexed stats `shouldBe` 0 + statsErrors stats `shouldBe` 0 diff --git a/haskell/test/Test/Storage.hs b/haskell/test/Test/Storage.hs new file mode 100644 --- /dev/null +++ b/haskell/test/Test/Storage.hs @@ -0,0 +1,46 @@ +module Test.Storage (spec) where + +import Test.Hspec +import System.IO.Temp (withSystemTempDirectory) +import qualified Data.ByteString as BS +import Glean.Storage +import Glean.RocksDB (RocksDB) + +spec :: Spec +spec = describe "Glean.Storage" $ do + + it "can store and retrieve a fact batch" $ do + withSystemTempDirectory "glean-test" $ \dir -> do + let config = defaultDbConfig dir + withStorage config $ \(db :: RocksDB) -> do + let batch = FactBatch + { batchData = BS.pack [1,2,3,4,5] + , batchFirstId = 1024 + , batchCount = 1 + , batchPredicates = mempty + } + store db batch + result <- retrieve db + result `shouldSatisfy` (/= Nothing) + + it "returns Nothing for empty database" $ do + withSystemTempDirectory "glean-test" $ \dir -> do + let config = defaultDbConfig dir + withStorage config $ \(db :: RocksDB) -> do + result <- retrieve db + result `shouldBe` Nothing + + it "persists fact count across connections" $ do + withSystemTempDirectory "glean-test" $ \dir -> do + let config = defaultDbConfig dir + let batch = FactBatch + { batchData = BS.pack [1,2,3] + , batchFirstId = 1024 + , batchCount = 5 + , batchPredicates = mempty + } + -- Write in first connection + withStorage config $ \(db :: RocksDB) -> do + store db batch + props <- properties db + propFactCount props `shouldBe` 5