valiant-plugin (empty) → 0.1.0.0
raw patch · 20 files changed
+1783/−0 lines, 20 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, containers, cryptohash-sha256, directory, edit-distance, filepath, ghc, hspec, process, temporary, text, time, valiant, valiant-plugin
Files
- CHANGELOG.md +21/−0
- LICENSE +27/−0
- README.md +57/−0
- e2e/Main.hs +16/−0
- e2e/PluginE2E.hs +32/−0
- src/Valiant/Plugin.hs +156/−0
- src/Valiant/Plugin/Cache.hs +160/−0
- src/Valiant/Plugin/Compat.hs +36/−0
- src/Valiant/Plugin/Config.hs +51/−0
- src/Valiant/Plugin/Errors.hs +158/−0
- src/Valiant/Plugin/Hash.hs +20/−0
- src/Valiant/Plugin/Rewrite.hs +246/−0
- src/Valiant/Plugin/Traverse.hs +161/−0
- src/Valiant/Plugin/TypeMap.hs +29/−0
- src/Valiant/Plugin/Verify.hs +156/−0
- test/Main.hs +12/−0
- test/Valiant/Plugin/CacheSpec.hs +48/−0
- test/Valiant/Plugin/ConfigSpec.hs +40/−0
- test/Valiant/Plugin/ErrorCaseSpec.hs +227/−0
- valiant-plugin.cabal +130/−0
+ CHANGELOG.md view
@@ -0,0 +1,21 @@+# Changelog++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),+and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).++## [0.1.0.0] - 2026-04-25++Initial release. GHC source plugin for+[`valiant`](https://hackage.haskell.org/package/valiant). Validates+SQL files referenced via `queryFile` against the project's+`.valiant/` cache at compile time, so parameter and result types are+checked before the program runs and out-of-date `.sql` files break+the build rather than the production query.++- Resolves `.sql` paths relative to the cabal package root.+- Reads the per-file cache entries written by `valiant prepare`.+- Reports unresolved files, type mismatches, and stale caches as+ GHC errors.+- No Template Haskell.++[0.1.0.0]: https://github.com/joshburgess/valiant/releases/tag/v0.1.0.0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2026 Josh Burgess++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from this+ software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,57 @@+# valiant-plugin++GHC source plugin for valiant. Validates raw `.sql` files against a+`.valiant/` cache at compile time.++## How it fits++The valiant workflow has three steps:++1. Run [`valiant prepare`](https://hackage.haskell.org/package/valiant-cli)+ against a live PostgreSQL database. The CLI reads each `.sql` file+ in your project, sends it to Postgres via `PREPARE` / `DESCRIBE`,+ and writes the parameter and result types into `.valiant/`.+2. Add `valiant-plugin` to your project's `ghc-options` (typically via+ `-fplugin=Valiant.Plugin`). The plugin watches for `queryFile`+ calls in your Haskell source.+3. At compile time, the plugin reads the cached metadata for each+ referenced `.sql` file and rewrites the call to a typed `Statement`+ value. Mismatches between the SQL types and the Haskell types you+ ask for become compile errors.++No Template Haskell. No code generation. Just metadata lookup at+compile time.++## Enabling the plugin++In your `.cabal` file:++```cabal+ghc-options: -fplugin=Valiant.Plugin+build-depends:+ , valiant+ , valiant-plugin+```++In your Haskell source:++```haskell+import Valiant++listUsers :: Statement () User+listUsers = queryFile "sql/list-users.sql"+```++The `queryFile` call becomes a typed `Statement () User` after the+plugin runs, with the type checked against `.valiant/list-users.sql.json`.++## Documentation++- [Top-level README](https://github.com/joshburgess/valiant#readme):+ project overview and the full setup walkthrough.+- [Tutorial](https://github.com/joshburgess/valiant/blob/main/docs/TUTORIAL.md):+ worked examples.++## License++BSD-3-Clause. See `LICENSE`.
+ e2e/Main.hs view
@@ -0,0 +1,16 @@+-- | If this compiles, the plugin is working: queryFile calls were+-- rewritten to mkStatement, and type signatures were validated+-- against the .valiant/ cache.+module Main where++import PluginE2E++main :: IO ()+main = do+ -- Just verify the statements exist and have the right SQL embedded.+ -- The real validation happened at compile time.+ let _ = findUserById+ let _ = listUsers+ let _ = insertUser+ let _ = findByNameAndStatus+ putStrLn "Plugin e2e: all queryFile calls compiled successfully."
+ e2e/PluginE2E.hs view
@@ -0,0 +1,32 @@+-- | End-to-end test: this module compiles with the plugin loaded.+-- The plugin rewrites queryFile calls to mkStatement calls and validates types.+module PluginE2E where++import Data.Int (Int32)+import Data.Text (Text)+import Data.Time (UTCTime)+import Valiant.Statement (Statement, queryFile)++-- | Positional params: SELECT 5 columns, 1 Int32 param.+-- sql/users/find_by_id.sql:+-- SELECT id, name, email, is_active, created_at FROM users WHERE id = $1+findUserById :: Statement Int32 (Int32, Text, Maybe Text, Bool, UTCTime)+findUserById = queryFile "users/find_by_id.sql"++-- | No params: SELECT 2 columns.+-- sql/users/list_all.sql:+-- SELECT id, name FROM users ORDER BY name+listUsers :: Statement () (Int32, Text)+listUsers = queryFile "users/list_all.sql"++-- | 2 params, no result columns (INSERT).+-- sql/users/insert.sql:+-- INSERT INTO users (name, email) VALUES ($1, $2)+insertUser :: Statement (Text, Maybe Text) ()+insertUser = queryFile "users/insert.sql"++-- | Named params: :name and :active mapped to $1 (Text) and $2 (Bool).+-- sql/users/find_by_name_and_status.sql:+-- SELECT id, name, email FROM users WHERE name = :name AND is_active = :active+findByNameAndStatus :: Statement (Text, Bool) (Int32, Text, Maybe Text)+findByNameAndStatus = queryFile "users/find_by_name_and_status.sql"
+ src/Valiant/Plugin.hs view
@@ -0,0 +1,156 @@+-- | GHC source plugin for compile-time SQL validation.+--+-- Usage:+--+-- > {-# OPTIONS_GHC -fplugin=Valiant.Plugin+-- > -fplugin-opt=Valiant.Plugin:sql-dir=sql #-}+module Valiant.Plugin+ ( plugin+ ) where++import Control.Monad (forM_, when)+import Data.ByteString qualified as BS+import GHC.Driver.Env.Types (Hsc)+import GHC.Driver.Plugins (ParsedResult (..))+import GHC.Hs (HsParsedModule (..))+import GHC.Unit.Module.ModSummary (ModSummary)+import GHC.Plugins+ ( CommandLineOption+ , GenLocated (..)+ , Plugin (..)+ , PluginRecompile (..)+ , defaultPlugin+ )+import GHC.Tc.Types (TcGblEnv (..), TcM)+import Valiant.Plugin.Rewrite (rewriteModule)+import GHC.Utils.Fingerprint (fingerprintFingerprints, fingerprintString)+import Valiant.Plugin.Cache (findCacheFile)+import Valiant.Plugin.Compat (addFileDependency)+import Valiant.Plugin.Config (PluginConfig (..), parseOptions, resolveConfig)+import Valiant.Plugin.Errors (errCacheStaleOrMissing, errSqlFileNotFound)+import Valiant.Plugin.Hash (sha256Hex)+import Valiant.Plugin.Traverse (QueryFileCall (..), findQueryFileCalls)+import Valiant.Plugin.Verify (verifyQueryFile)+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)+import System.FilePath ((</>))+import Data.List (sort)+import Control.Monad.IO.Class (liftIO)+import Text.EditDistance (defaultEditCosts, levenshteinDistance)+import System.FilePath.Posix (makeRelative)++-- | The valiant GHC source plugin.+plugin :: Plugin+plugin =+ defaultPlugin+ { parsedResultAction = valiantRewrite+ , typeCheckResultAction = valiantTypeCheck+ , pluginRecompile = valiantRecompile+ }++-- | Before typechecking, rewrite queryFile calls to mkStatement calls.+valiantRewrite :: [CommandLineOption] -> ModSummary -> ParsedResult -> Hsc ParsedResult+valiantRewrite opts _modSummary parsedResult = do+ let config = parseOptions opts+ hpm = parsedResultModule parsedResult+ L loc hsmod = hpm_module hpm+ (hsmod', _anyRewritten) <- rewriteModule config hsmod+ let hpm' = hpm {hpm_module = L loc hsmod'}+ pure parsedResult {parsedResultModule = hpm'}++-- | After typechecking, walk the AST and validate queryFile calls.+valiantTypeCheck :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv+valiantTypeCheck opts _modSummary tcEnv = do+ config <- liftIO $ resolveConfig opts+ let calls = findQueryFileCalls tcEnv++ forM_ calls $ \call -> do+ processQueryFileCall config call++ pure tcEnv++-- | Process a single queryFile call: validate the file, load cache, verify types.+-- In offline mode, skip all validation (only register file dependencies).+processQueryFileCall :: PluginConfig -> QueryFileCall -> TcM ()+processQueryFileCall config call+ | pcOffline config = do+ -- Offline mode: skip all validation. The rewrite phase already handles+ -- missing cache files gracefully. Just register the dependency if the+ -- file exists so GHC recompiles when it appears.+ let sqlPath = pcSqlDir config </> qfcFilePath call+ sqlExists <- liftIO $ doesFileExist sqlPath+ when sqlExists $ addFileDependency sqlPath+ | otherwise = do+ let sqlDir = pcSqlDir config+ cacheDir = pcCacheDir config+ relPath = qfcFilePath call+ sqlPath = sqlDir </> relPath+ srcSpan = qfcSrcSpan call++ -- 1. Check that the .sql file exists+ sqlExists <- liftIO $ doesFileExist sqlPath+ if not sqlExists+ then do+ suggestions <- liftIO $ findSimilarFiles sqlDir relPath+ errSqlFileNotFound srcSpan relPath suggestions+ else do+ -- 2. Register as a file dependency for recompilation+ addFileDependency sqlPath++ -- 3. Read and hash the SQL content+ sqlContent <- liftIO $ BS.readFile sqlPath+ let sqlHash = sha256Hex sqlContent++ -- 4. Find the matching cache file+ mCacheMeta <- liftIO $ findCacheFile cacheDir relPath sqlHash+ case mCacheMeta of+ Nothing ->+ errCacheStaleOrMissing srcSpan relPath+ Just entry ->+ -- 5. Verify types+ verifyQueryFile call entry++-- | Determine recompilation based on .valiant/ cache directory fingerprint.+valiantRecompile :: [CommandLineOption] -> IO PluginRecompile+valiantRecompile opts = do+ let config = parseOptions opts+ cacheDir = pcCacheDir config+ exists <- doesDirectoryExist cacheDir+ if not exists+ then pure ForceRecompile+ else do+ files <- sort <$> listDirectory cacheDir+ let fingerprint = fingerprintFingerprints [fingerprintString f | f <- files]+ pure (MaybeRecompile fingerprint)++-- | Find similar .sql files for "did you mean" suggestions.+findSimilarFiles :: FilePath -> FilePath -> IO [FilePath]+findSimilarFiles sqlDir target = do+ exists <- doesDirectoryExist sqlDir+ if not exists+ then pure []+ else do+ allFiles <- findSqlFiles sqlDir+ let distances = [(f, levenshteinDistance defaultEditCosts target f) | f <- allFiles]+ sorted = map fst $ filter (\(_, d) -> d <= 5) $ sortOn snd distances+ pure (take 3 sorted)+ where+ sortOn f = map snd . sort . map (\x -> (f x, x))++findSqlFiles :: FilePath -> IO [FilePath]+findSqlFiles dir = do+ entries <- listDirectory dir+ let go acc [] = pure acc+ go acc (e : es) = do+ let path = dir </> e+ isDir <- doesDirectoryExist path+ if isDir+ then do+ subFiles <- findSqlFiles path+ go (acc ++ subFiles) es+ else+ if ".sql" `isSuffixOf` e+ then go (makeRelative dir path : acc) es+ else go acc es+ go [] entries+ where+ isSuffixOf suffix s = drop (length s - length suffix) s == suffix
+ src/Valiant/Plugin/Cache.hs view
@@ -0,0 +1,160 @@+-- | Internal: cache entry types for the @valiant-plugin@. The public+-- entry point is "Valiant.Plugin"; this module is exposed only so+-- the plugin's test suite can exercise it. Not stable API.+module Valiant.Plugin.Cache+ ( CacheEntry (..)+ , CacheParam (..)+ , CacheColumn (..)+ , StatementType (..)+ , readCacheEntry+ , findCacheFile+ , findCacheBySqlHash+ , cacheFileName+ ) where++import Data.Aeson (FromJSON (..), eitherDecodeStrict, withObject, withText, (.:), (.:?))+import Data.ByteString qualified as BS+import Data.List (find, isSuffixOf)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (UTCTime)+import Data.Word (Word32)+import System.Directory (doesDirectoryExist, listDirectory)+import System.FilePath ((</>))++-- Types (mirrored from Valiant.CLI.Cache) -----------------------------------++data CacheEntry = CacheEntry+ { ceVersion :: Text+ , ceFile :: FilePath+ , ceSqlHash :: Text+ , ceSql :: Text+ , ceDbUrlHash :: Text+ , cePreparedAt :: UTCTime+ , ceStatementType :: StatementType+ , ceParams :: [CacheParam]+ , ceColumns :: [CacheColumn]+ }+ deriving stock (Show, Eq)++data StatementType = Select | Insert | Update | Delete | Other+ deriving stock (Show, Eq)++data CacheParam = CacheParam+ { cpIndex :: Int+ , cpPgOid :: Word32+ , cpPgTypeName :: Text+ , cpHaskellType :: Text+ , cpHaskellModule :: Text+ }+ deriving stock (Show, Eq)++data CacheColumn = CacheColumn+ { ccName :: Text+ , ccPgOid :: Word32+ , ccPgTypeName :: Text+ , ccNullable :: Bool+ , ccHaskellType :: Text+ , ccHaskellModule :: Text+ , ccSourceTableOid :: Maybe Word32+ , ccSourceColumnNum :: Maybe Int+ }+ deriving stock (Show, Eq)++-- JSON instances ----------------------------------------------------------++instance FromJSON CacheEntry where+ parseJSON = withObject "CacheEntry" $ \o ->+ CacheEntry+ <$> o .: "valiant_version"+ <*> o .: "file"+ <*> o .: "sql_hash"+ <*> o .: "sql"+ <*> o .: "database_url_hash"+ <*> o .: "prepared_at"+ <*> o .: "statement_type"+ <*> o .: "parameters"+ <*> o .: "columns"++instance FromJSON StatementType where+ parseJSON = withText "StatementType" $ \case+ "select" -> pure Select+ "insert" -> pure Insert+ "update" -> pure Update+ "delete" -> pure Delete+ _ -> pure Other++instance FromJSON CacheParam where+ parseJSON = withObject "CacheParam" $ \o ->+ CacheParam+ <$> o .: "index"+ <*> o .: "pg_oid"+ <*> o .: "pg_type_name"+ <*> o .: "haskell_type"+ <*> o .: "haskell_module"++instance FromJSON CacheColumn where+ parseJSON = withObject "CacheColumn" $ \o ->+ CacheColumn+ <$> o .: "name"+ <*> o .: "pg_oid"+ <*> o .: "pg_type_name"+ <*> o .: "nullable"+ <*> o .: "haskell_type"+ <*> o .: "haskell_module"+ <*> o .:? "source_table_oid"+ <*> o .:? "source_column_number"++-- File operations ---------------------------------------------------------++readCacheEntry :: FilePath -> IO (Either String CacheEntry)+readCacheEntry path = eitherDecodeStrict <$> BS.readFile path++findCacheFile :: FilePath -> FilePath -> Text -> IO (Maybe CacheEntry)+findCacheFile cacheDir sqlRelPath sqlHash = do+ exists <- doesDirectoryExist cacheDir+ if not exists+ then pure Nothing+ else do+ files <- listDirectory cacheDir+ let hashShort = T.take 12 sqlHash+ expected = cacheFileName sqlRelPath hashShort+ case find (== expected) files of+ Nothing -> pure Nothing+ Just f -> do+ result <- readCacheEntry (cacheDir </> f)+ pure $ case result of+ Left _ -> Nothing+ Right entry+ | ceSqlHash entry == sqlHash -> Just entry+ | otherwise -> Nothing++-- | Find a cache entry by SQL hash alone (for inline SQL without a file path).+-- Scans all cache files in the directory looking for a matching sql_hash.+findCacheBySqlHash :: FilePath -> Text -> IO (Maybe CacheEntry)+findCacheBySqlHash cacheDir sqlHash = do+ exists <- doesDirectoryExist cacheDir+ if not exists+ then pure Nothing+ else do+ files <- listDirectory cacheDir+ let jsonFiles = filter (".json" `isSuffixOf`) files+ go jsonFiles+ where+ go [] = pure Nothing+ go (f : fs) = do+ result <- readCacheEntry (cacheDir </> f)+ case result of+ Right entry | ceSqlHash entry == sqlHash -> pure (Just entry)+ _ -> go fs++cacheFileName :: FilePath -> Text -> FilePath+cacheFileName sqlRelPath hashShort =+ T.unpack (slug <> "-" <> hashShort) <> ".json"+ where+ slug =+ T.replace "/" "-" . T.replace "\\" "-" . T.pack $+ dropSqlExt sqlRelPath+ dropSqlExt p+ | ".sql" `isSuffixOf` p = take (length p - 4) p+ | otherwise = p
+ src/Valiant/Plugin/Compat.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}++-- | GHC version compatibility layer for the valiant plugin.+--+-- Abstracts over GHC API changes between 9.6, 9.8, and 9.10.+module Valiant.Plugin.Compat+ ( emitPluginError+ , addFileDependency+ ) where++import GHC.Plugins (SDoc)+import GHC.Tc.Errors.Types (TcRnMessage (..))+import GHC.Tc.Utils.Monad (TcM, addErrAt, addDependentFiles)+import GHC.Types.SrcLoc (SrcSpan)++#if MIN_VERSION_ghc(9, 8, 0)+import GHC.Types.Error (mkSimpleUnknownDiagnostic, noHints, mkPlainError)+#else+import GHC.Types.Error (mkPlainError, noHints)+#endif++-- | Emit a compile error from the plugin at a specific source location.+emitPluginError :: SrcSpan -> SDoc -> TcM ()+#if MIN_VERSION_ghc(9, 8, 0)+-- GHC 9.8+: requires mkSimpleUnknownDiagnostic wrapper+emitPluginError srcSpan msg =+ addErrAt srcSpan (TcRnUnknownMessage (mkSimpleUnknownDiagnostic (mkPlainError noHints msg)))+#else+-- GHC 9.6: TcRnUnknownMessage takes the diagnostic directly+emitPluginError srcSpan msg =+ addErrAt srcSpan (TcRnUnknownMessage (mkPlainError noHints msg))+#endif++-- | Register a file as a dependency for recompilation tracking.+addFileDependency :: FilePath -> TcM ()+addFileDependency path = addDependentFiles [path]
+ src/Valiant/Plugin/Config.hs view
@@ -0,0 +1,51 @@+-- | Internal: plugin option parsing for the @valiant-plugin@. The+-- public entry point is "Valiant.Plugin"; this module is exposed+-- only so the plugin's test suite can exercise it. Not stable API.+module Valiant.Plugin.Config+ ( PluginConfig (..)+ , defaultConfig+ , parseOptions+ , resolveConfig+ ) where++import Data.List qualified as List+import System.Environment (lookupEnv)++-- | Plugin configuration parsed from @-fplugin-opt@ flags.+data PluginConfig = PluginConfig+ { pcSqlDir :: FilePath+ , pcCacheDir :: FilePath+ , pcOffline :: Bool+ }+ deriving stock (Show, Eq)++defaultConfig :: PluginConfig+defaultConfig =+ PluginConfig+ { pcSqlDir = "sql"+ , pcCacheDir = ".valiant"+ , pcOffline = False+ }++-- | Parse plugin command-line options.+-- Options are @key=value@ strings passed via @-fplugin-opt=Valiant.Plugin:key=value@.+parseOptions :: [String] -> PluginConfig+parseOptions = List.foldl' applyOpt defaultConfig+ where+ applyOpt cfg opt = case break (== '=') opt of+ ("sql-dir", '=' : val) -> cfg {pcSqlDir = val}+ ("cache-dir", '=' : val) -> cfg {pcCacheDir = val}+ ("offline", '=' : "true") -> cfg {pcOffline = True}+ ("offline", '=' : "false") -> cfg {pcOffline = False}+ _ -> cfg -- ignore unknown options++-- | Parse plugin options and resolve environment variable overrides.+-- If @VALIANT_OFFLINE@ is set to @\"true\"@ or @\"1\"@, forces offline mode.+resolveConfig :: [String] -> IO PluginConfig+resolveConfig opts = do+ let cfg = parseOptions opts+ mOffline <- lookupEnv "VALIANT_OFFLINE"+ pure $ case mOffline of+ Just "true" -> cfg {pcOffline = True}+ Just "1" -> cfg {pcOffline = True}+ _ -> cfg
+ src/Valiant/Plugin/Errors.hs view
@@ -0,0 +1,158 @@+-- | Rich compile-time error messages for valiant.+module Valiant.Plugin.Errors+ ( errSqlFileNotFound+ , errCacheStaleOrMissing+ , errParamTypeMismatch+ , errParamCountMismatch+ , errResultTypeMismatch+ , errColumnCountMismatch+ ) where++import Data.Text (Text)+import Data.Text qualified as T+import GHC.Plugins (SDoc, text, vcat, (<+>), empty, hcat)+import GHC.Types.SrcLoc (SrcSpan)+import Valiant.Plugin.Cache (CacheColumn (..), CacheParam (..))+import Valiant.Plugin.Compat (emitPluginError)+import GHC.Tc.Utils.Monad (TcM)++-- Shorthand for concatenation without spaces+(<<>>) :: SDoc -> SDoc -> SDoc+a <<>> b = hcat [a, b]++-- | VALIANT-001: SQL file not found.+errSqlFileNotFound :: SrcSpan -> FilePath -> [FilePath] -> TcM ()+errSqlFileNotFound srcSpan path suggestions =+ emitPluginError srcSpan $+ vcat+ [ text "[VALIANT-001] SQL file not found"+ , text ""+ , text " queryFile references a file that doesn't exist:"+ , text " " <<>> text path+ , text ""+ , suggestBlock suggestions+ , text " Fix: correct the filename in your queryFile call."+ ]++suggestBlock :: [FilePath] -> SDoc+suggestBlock [] = empty+suggestBlock xs =+ vcat $+ [text " Did you mean one of these?"]+ ++ [text " - " <<>> text x | x <- take 3 xs]+ ++ [text ""]++-- | VALIANT-002: Cache stale or missing.+errCacheStaleOrMissing :: SrcSpan -> FilePath -> TcM ()+errCacheStaleOrMissing srcSpan path =+ emitPluginError srcSpan $+ vcat+ [ text "[VALIANT-002] Query not prepared"+ , text ""+ , text " No cached metadata found for:"+ , text " " <<>> text path+ , text ""+ , text " This means either:"+ , text " 1. You haven't run `valiant prepare` yet, or"+ , text " 2. The SQL file has changed since the last prepare."+ , text ""+ , text " Fix: run `valiant prepare` then rebuild."+ ]++-- | VALIANT-005: Parameter type mismatch.+errParamTypeMismatch :: SrcSpan -> FilePath -> Int -> Text -> Text -> TcM ()+errParamTypeMismatch srcSpan path paramIdx expected actual =+ emitPluginError srcSpan $+ vcat+ [ text "[VALIANT-005] Parameter type mismatch"+ , text ""+ , text " Parameter $" <<>> text (show paramIdx)+ <+> text "in" <+> text path+ , text ""+ , text " Postgres expects:" <+> text (T.unpack expected)+ , text " Your type: " <+> text (T.unpack actual)+ , text ""+ , text " Fix: change the parameter type to" <+> text (T.unpack expected)+ ]++-- | VALIANT-006: Parameter count mismatch.+errParamCountMismatch :: SrcSpan -> FilePath -> Int -> Int -> [CacheParam] -> TcM ()+errParamCountMismatch srcSpan path expected actual params =+ emitPluginError srcSpan $+ vcat $+ [ text "[VALIANT-006] Parameter count mismatch"+ , text ""+ , text " Your type provides" <+> text (show actual) <+> text "parameter(s)"+ , text " but the query expects" <+> text (show expected)+ , text ""+ , text " SQL" <+> text ("(" ++ path ++ ")") <+> text "expects:"+ ]+ ++ [text " $" <<>> text (show (cpIndex p))+ <+> text "::" <+> text (T.unpack (cpHaskellType p))+ | p <- params]+ ++ [ text ""+ , text " Fix:" <+> fixHint+ ]+ where+ fixHint+ | expected == 0 = text "use () as the parameter type."+ | expected == 1 = text "use a single type, not a tuple."+ | otherwise = text "use a" <+> text (show expected) <<>> text "-tuple for parameters."++-- | VALIANT-003: Result type mismatch (column type mismatch).+errResultTypeMismatch :: SrcSpan -> FilePath -> [(CacheColumn, Text, Bool)] -> TcM ()+errResultTypeMismatch srcSpan path mismatches =+ emitPluginError srcSpan $+ vcat $+ [ text "[VALIANT-003] Result type mismatch"+ , text ""+ , text " Your type doesn't match what Postgres returns for" <+> text path+ , text ""+ , text " Column PG type Your type Match"+ , text " ────── ─────── ───────── ─────"+ ]+ ++ [formatMismatch m | m <- mismatches]+ ++ nullabilityHints+ ++ [ text ""+ , text " Fix: update your type signature to match the expected types."+ ]+ where+ formatMismatch (col, userType, ok) =+ text " " <<>> padR 13 (ccName col) <<>> padR 16 (ccPgTypeName col) <<>> padR 17 userType+ <<>> text (if ok then "OK" else "MISMATCH")+ padR n t = text (T.unpack t ++ replicate (max 0 (n - T.length t)) ' ')+ nullabilityHints =+ let hints = concatMap nullHint mismatches+ in if null hints then [] else text "" : hints+ nullHint (col, userType, False)+ | ccNullable col && not (T.isPrefixOf "Maybe" (T.strip userType)) =+ [ text " Column" <+> text (show (T.unpack (ccName col)))+ <+> text "can be NULL. Wrap in Maybe:" <+> text ("Maybe " ++ T.unpack (T.strip userType))+ , text " Or force non-null in SQL: SELECT ..." <+> text (T.unpack (ccName col))+ <+> text "AS" <+> text (show (T.unpack (ccName col) ++ "!")) <+> text "..."+ ]+ | not (ccNullable col) && T.isPrefixOf "Maybe" (T.strip userType) =+ [ text " Column" <+> text (show (T.unpack (ccName col)))+ <+> text "is NOT NULL. Remove the Maybe wrapper."+ ]+ nullHint _ = []++-- | VALIANT-004: Column count mismatch.+errColumnCountMismatch :: SrcSpan -> FilePath -> Int -> Int -> [CacheColumn] -> TcM ()+errColumnCountMismatch srcSpan path expected actual cols =+ emitPluginError srcSpan $+ vcat $+ [ text "[VALIANT-004] Column count mismatch"+ , text ""+ , text " Your type has" <+> text (show actual) <+> text "field(s)"+ , text " but the query returns" <+> text (show expected) <+> text "column(s)."+ , text ""+ , text " SQL" <+> text ("(" ++ path ++ ")") <+> text "returns:"+ ]+ ++ [ text " " <<>> text (show i) <<>> text "." <+> text (T.unpack (ccName c))+ <+> text "::" <+> text (T.unpack (ccHaskellType c))+ | (i, c) <- zip [(1 :: Int) ..] cols+ ]+ ++ [ text ""+ , text " Fix: update your result type to have" <+> text (show expected) <+> text "field(s)."+ ]
+ src/Valiant/Plugin/Hash.hs view
@@ -0,0 +1,20 @@+module Valiant.Plugin.Hash+ ( sha256Hex+ ) where++import Crypto.Hash.SHA256 qualified as SHA256+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Text (Text)+import Data.Text qualified as T+import Data.Word (Word8)+import Numeric (showHex)++-- | Full SHA-256 hex digest of a 'ByteString'.+sha256Hex :: ByteString -> Text+sha256Hex = T.pack . concatMap toHex . BS.unpack . SHA256.hash++toHex :: Word8 -> String+toHex w+ | w < 16 = '0' : showHex w ""+ | otherwise = showHex w ""
+ src/Valiant/Plugin/Rewrite.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE CPP #-}++-- | Parsed-AST rewrite: replace @queryFile "path.sql"@ with @mkStatement ...@.+module Valiant.Plugin.Rewrite+ ( rewriteModule+ ) where++import Control.Monad.IO.Class (liftIO)+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import GHC.Driver.Env.Types (Hsc)+import GHC.Data.FastString (fsLit, unpackFS)+import GHC.Hs+import GHC.Plugins (GenLocated (..), Outputable, ppr, showSDocUnsafe)+import GHC.Types.PkgQual (RawPkgQual (..))+import GHC.Types.Name.Occurrence (mkVarOcc, occNameString)+import GHC.Types.Name.Reader (mkRdrQual, rdrNameOcc)+import GHC.Types.SourceText (SourceText (..), mkIntegralLit)+import Valiant.Plugin.Cache (CacheColumn (..), CacheEntry (..), CacheParam (..), findCacheFile, findCacheBySqlHash)+import Valiant.Plugin.Config (PluginConfig (..))+import Valiant.Plugin.Hash (sha256Hex)+import System.Directory (doesFileExist)+import System.FilePath ((</>))++-- | Rewrite a parsed module, replacing queryFile calls with mkStatement calls.+-- Returns the modified module and whether any rewrites were made.+rewriteModule :: PluginConfig -> HsModule GhcPs -> Hsc (HsModule GhcPs, Bool)+rewriteModule config hsmod = do+ (decls', anyRewritten) <- rewriteDecls config (hsmodDecls hsmod)+ let hsmod' =+ if anyRewritten+ then hsmod+ { hsmodDecls = decls'+ , hsmodImports = addImport (stripQueryFileImports (hsmodImports hsmod))+ }+ else hsmod+ pure (hsmod', anyRewritten)++-- | Rewrite all declarations, tracking whether any rewrites occurred.+rewriteDecls :: PluginConfig -> [LHsDecl GhcPs] -> Hsc ([LHsDecl GhcPs], Bool)+rewriteDecls config decls = do+ results <- mapM (rewriteDecl config) decls+ let decls' = map fst results+ anyRewritten = any snd results+ pure (decls', anyRewritten)++rewriteDecl :: PluginConfig -> LHsDecl GhcPs -> Hsc (LHsDecl GhcPs, Bool)+rewriteDecl config (L loc (ValD x bind)) = do+ (bind', rewritten) <- rewriteBind config bind+ pure (L loc (ValD x bind'), rewritten)+rewriteDecl _ decl = pure (decl, False)++rewriteBind :: PluginConfig -> HsBind GhcPs -> Hsc (HsBind GhcPs, Bool)+rewriteBind config fb@FunBind {fun_matches = mg} = do+ (mg', rewritten) <- rewriteMatchGroup config mg+ pure (fb {fun_matches = mg'}, rewritten)+rewriteBind _ bind = pure (bind, False)++rewriteMatchGroup :: PluginConfig -> MatchGroup GhcPs (LHsExpr GhcPs) -> Hsc (MatchGroup GhcPs (LHsExpr GhcPs), Bool)+rewriteMatchGroup config mg = case mg_alts mg of+ L altsLoc alts -> do+ results <- mapM (rewriteLMatch config) alts+ let alts' = map fst results+ anyRewritten = any snd results+ pure (mg {mg_alts = L altsLoc alts'}, anyRewritten)++rewriteLMatch :: PluginConfig -> LMatch GhcPs (LHsExpr GhcPs) -> Hsc (LMatch GhcPs (LHsExpr GhcPs), Bool)+rewriteLMatch config (L loc match) = do+ (grhss', rewritten) <- rewriteGRHSs config (m_grhss match)+ pure (L loc match {m_grhss = grhss'}, rewritten)++rewriteGRHSs :: PluginConfig -> GRHSs GhcPs (LHsExpr GhcPs) -> Hsc (GRHSs GhcPs (LHsExpr GhcPs), Bool)+rewriteGRHSs config grhss = do+ results <- mapM (rewriteGRHS config) (grhssGRHSs grhss)+ let grhss' = map fst results+ anyRewritten = any snd results+ pure (grhss {grhssGRHSs = grhss'}, anyRewritten)++rewriteGRHS :: PluginConfig -> LGRHS GhcPs (LHsExpr GhcPs) -> Hsc (LGRHS GhcPs (LHsExpr GhcPs), Bool)+rewriteGRHS config (L loc (GRHS x guards body)) = do+ (body', rewritten) <- rewriteLExpr config body+ pure (L loc (GRHS x guards body'), rewritten)++rewriteLExpr :: PluginConfig -> LHsExpr GhcPs -> Hsc (LHsExpr GhcPs, Bool)+rewriteLExpr config (L loc expr) = do+ (expr', rewritten) <- rewriteExpr config expr+ pure (L loc expr', rewritten)++rewriteExpr :: PluginConfig -> HsExpr GhcPs -> Hsc (HsExpr GhcPs, Bool)+rewriteExpr config (HsApp _ (L _ func) (L _ arg))+ -- queryFile "path.sql" — load SQL from file, look up cache by path+hash+ | isQueryFileRdr func+ , Just path <- extractParsedStringLit arg = do+ mEntry <- liftIO $ loadCacheForPath config path+ case mEntry of+ Just entry -> do+ let replacement = buildMkStatementCall entry+ pure (replacement, True)+ Nothing -> do+ let placeholder = buildPlaceholderCall path+ pure (placeholder, True)+ -- query "SELECT ..." — inline SQL, look up cache by SQL hash directly+ | isQueryInlineRdr func+ , Just sqlText <- extractParsedStringLit arg = do+ mEntry <- liftIO $ loadCacheForInlineSql config sqlText+ case mEntry of+ Just entry -> do+ let replacement = buildMkStatementCall entry+ pure (replacement, True)+ Nothing -> do+ -- No cache for this SQL text. Use a placeholder that includes+ -- the SQL itself as the "path" so the typecheck phase can report it.+ let placeholder = buildPlaceholderInline sqlText+ pure (placeholder, True)+rewriteExpr _ expr = pure (expr, False)++-- Builders ----------------------------------------------------------------++-- | Build a placeholder @mkStatement "" [] [] path@ for when cache is missing.+-- This avoids the ValiantPluginRequired TypeError while letting the typecheck+-- phase detect the call and emit a proper VALIANT-001/002 error.+buildPlaceholderCall :: String -> HsExpr GhcPs+buildPlaceholderCall path =+ let mkSt = mkQualVar "Valiant.Statement" "mkStatement"+ sql = mkStrLit ""+ oids = mkIntList []+ cols = mkStrList []+ pathLit = mkStrLit path+ in unLoc (mkSt `app` sql `app` oids `app` cols `app` pathLit)++-- | Build a placeholder for inline SQL when cache is missing.+buildPlaceholderInline :: String -> HsExpr GhcPs+buildPlaceholderInline sqlText =+ let mkSt = mkQualVar "Valiant.Statement" "mkStatement"+ sql = mkStrLit sqlText+ oids = mkIntList []+ cols = mkStrList []+ pathLit = mkStrLit "<inline>"+ in unLoc (mkSt `app` sql `app` oids `app` cols `app` pathLit)++-- | Build: @Valiant.Statement.mkStatement sqlStr oids colNames path@+buildMkStatementCall :: CacheEntry -> HsExpr GhcPs+buildMkStatementCall entry =+ let mkSt = mkQualVar "Valiant.Statement" "mkStatement"+ sql = mkStrLit (T.unpack (ceSql entry))+ oids = mkIntList [fromIntegral (cpPgOid p) | p <- ceParams entry]+ cols = mkStrList [T.unpack (ccName c) | c <- ceColumns entry]+ path = mkStrLit (ceFile entry)+ in unLoc (mkSt `app` sql `app` oids `app` cols `app` path)++mkQualVar :: String -> String -> LHsExpr GhcPs+mkQualVar modName varName =+ noLocA $ HsVar noExtField (noLocA (mkRdrQual (mkModuleName modName) (mkVarOcc varName)))++mkStrLit :: String -> LHsExpr GhcPs+mkStrLit s = noLocA $ HsLit noExtField (HsString NoSourceText (fsLit s))++mkIntList :: [Int] -> LHsExpr GhcPs+mkIntList xs = noLocA $ ExplicitList noAnn [mkIntLit (fromIntegral x) | x <- xs]++mkIntLit :: Integer -> LHsExpr GhcPs+mkIntLit n = noLocA $ HsOverLit noExtField (mkHsIntegral (mkIntegralLit n))++mkStrList :: [String] -> LHsExpr GhcPs+mkStrList xs = noLocA $ ExplicitList noAnn [mkStrLit s | s <- xs]++app :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs+app f x = noLocA $ HsApp noExtField f x++unLoc :: GenLocated l a -> a+unLoc (L _ a) = a++-- Helpers -----------------------------------------------------------------++isQueryFileRdr :: HsExpr GhcPs -> Bool+isQueryFileRdr (HsVar _ (L _ rdr)) =+ let s = occNameString (rdrNameOcc rdr)+ in s == "queryFile" || s == "queryFileAs"+isQueryFileRdr _ = False++isQueryInlineRdr :: HsExpr GhcPs -> Bool+isQueryInlineRdr (HsVar _ (L _ rdr)) =+ occNameString (rdrNameOcc rdr) == "query"+isQueryInlineRdr _ = False++extractParsedStringLit :: HsExpr GhcPs -> Maybe String+extractParsedStringLit (HsLit _ (HsString _ fs)) = Just (unpackFS fs)+extractParsedStringLit _ = Nothing++loadCacheForPath :: PluginConfig -> String -> IO (Maybe CacheEntry)+loadCacheForPath config path = do+ let sqlPath = pcSqlDir config </> path+ exists <- doesFileExist sqlPath+ if not exists+ then pure Nothing+ else do+ content <- BS.readFile sqlPath+ let hash = sha256Hex content+ findCacheFile (pcCacheDir config) path hash++loadCacheForInlineSql :: PluginConfig -> String -> IO (Maybe CacheEntry)+loadCacheForInlineSql config sqlText = do+ let sqlBs = TE.encodeUtf8 (T.pack sqlText)+ hash = sha256Hex sqlBs+ findCacheBySqlHash (pcCacheDir config) hash++-- | Remove @queryFile@ and @queryFileAs@ from explicit import lists.+-- After the plugin rewrites these calls to @mkStatement@, the imports+-- would be redundant and trigger @-Wunused-imports@.+-- Uses 'showPpr' to convert IE items to strings for robust matching+-- across GHC versions.+stripQueryFileImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]+stripQueryFileImports = map stripImportDecl+ where+ stripImportDecl (L loc decl) = case ideclImportList decl of+ Just (listType, L listLoc ies) ->+ let ies' = filter (not . isQueryFileIE) ies+ in L loc decl { ideclImportList = Just (listType, L listLoc ies') }+ Nothing -> L loc decl++ isQueryFileIE :: LIE GhcPs -> Bool+ isQueryFileIE (L _ ie) =+ let s = showPprUnsafe ie+ in s == "queryFile" || s == "queryFileAs" || s == "query"++ showPprUnsafe :: (Outputable a) => a -> String+ showPprUnsafe = showSDocUnsafe . ppr++-- | Add @import qualified Valiant.Statement@ (implicit) to the import list.+addImport :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]+addImport imports = mkStatementImport : imports++mkStatementImport :: LImportDecl GhcPs+mkStatementImport =+ noLocA+ ImportDecl+ { ideclExt = XImportDeclPass noAnn NoSourceText True+ , ideclName = noLocA (mkModuleName "Valiant.Statement")+ , ideclPkgQual = NoRawPkgQual+ , ideclSource = NotBoot+ , ideclSafe = False+ , ideclQualified = QualifiedPre+ , ideclAs = Nothing+ , ideclImportList = Nothing+ }
+ src/Valiant/Plugin/Traverse.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE CPP #-}++-- | Walk the typechecked AST to find queryFile/queryFileAs/mkStatement call sites.+module Valiant.Plugin.Traverse+ ( QueryFileCall (..)+ , findQueryFileCalls+ ) where++import GHC.Hs+import GHC.Plugins+ ( Var, idType, varName, nameOccName, occNameString+ , GenLocated(..), SrcSpan+ )+import GHC.Tc.Types (TcGblEnv (..))+import GHC.Core.Type (Type)+import GHC.Data.Bag (bagToList)+import GHC.Data.FastString (unpackFS)++-- | A located queryFile call extracted from the AST.+data QueryFileCall = QueryFileCall+ { qfcSrcSpan :: SrcSpan+ , qfcFilePath :: String+ , qfcBindType :: Type+ , qfcBindName :: String+ }++-- | Find all queryFile/queryFileAs/mkStatement calls in the typechecked module.+-- After the parse-phase rewrite, queryFile calls become mkStatement calls.+-- We detect both forms to handle modules compiled with and without rewriting.+findQueryFileCalls :: TcGblEnv -> [QueryFileCall]+findQueryFileCalls env =+ concatMap findInBind (bagToList (tcg_binds env))++findInBind :: GenLocated l (HsBindLR GhcTc GhcTc) -> [QueryFileCall]+findInBind (L _ FunBind {fun_id = L _ var, fun_matches = matches}) =+ let bindName = occNameString (nameOccName (varName var))+ bindType = idType var+ calls = findCallsInMG matches+ in [ QueryFileCall sp path bindType bindName | (sp, path) <- calls ]+findInBind (L _ (XHsBindsLR AbsBinds {abs_binds = binds})) =+ concatMap findInBind (bagToList binds)+findInBind (L _ VarBind {var_id = var, var_rhs = rhs}) =+ let bindName = occNameString (nameOccName (varName var))+ bindType = idType var+ calls = findCallsInLExpr rhs+ in [ QueryFileCall sp path bindType bindName | (sp, path) <- calls ]+findInBind _ = []++findCallsInMG :: MatchGroup GhcTc (LHsExpr GhcTc) -> [(SrcSpan, String)]+findCallsInMG mg = case mg_alts mg of+ L _ alts -> concatMap (\(L _ m) -> findCallsInMatch m) alts++findCallsInMatch :: Match GhcTc (LHsExpr GhcTc) -> [(SrcSpan, String)]+findCallsInMatch Match {m_grhss = grhss} =+ concatMap (\(L _ g) -> findCallsInGRHS g) (grhssGRHSs grhss)++findCallsInGRHS :: GRHS GhcTc (LHsExpr GhcTc) -> [(SrcSpan, String)]+findCallsInGRHS (GRHS _ _ body) = findCallsInLExpr body++findCallsInLExpr :: LHsExpr GhcTc -> [(SrcSpan, String)]+findCallsInLExpr (L ann expr) = findCallsInExpr (getLocA (L ann expr)) expr++findCallsInExpr :: SrcSpan -> HsExpr GhcTc -> [(SrcSpan, String)]+findCallsInExpr sp expr =+ -- First, try to detect mkStatement (rewritten queryFile)+ case extractMkStatementCall expr of+ Just path -> [(sp, path)]+ Nothing -> case expr of+ -- Original queryFile "path.sql" (not rewritten)+ HsApp _ (L _ func) (L _ arg)+ | isQueryFileExpr func+ , Just path <- extractStringLit arg ->+ [(sp, path)]+ HsApp _ func arg ->+ findCallsInLExpr func ++ findCallsInLExpr arg+ OpApp _ l op r ->+ findCallsInLExpr l ++ findCallsInLExpr op ++ findCallsInLExpr r+ NegApp _ e _ -> findCallsInLExpr e+#if MIN_VERSION_ghc(9, 10, 0)+ HsPar _ e -> findCallsInLExpr e+#else+ HsPar _ _ e _ -> findCallsInLExpr e+#endif+ SectionL _ e1 e2 -> findCallsInLExpr e1 ++ findCallsInLExpr e2+ SectionR _ e1 e2 -> findCallsInLExpr e1 ++ findCallsInLExpr e2+ ExplicitTuple _ args _ ->+ concatMap (\case Present _ e -> findCallsInLExpr e; _ -> []) args+#if MIN_VERSION_ghc(9, 10, 0)+ HsLet _ _ e -> findCallsInLExpr e+#else+ HsLet _ _ _ _ e -> findCallsInLExpr e+#endif+ HsCase _ scrut mg ->+ findCallsInLExpr scrut ++ findCallsInMG mg+ HsIf _ c t f ->+ findCallsInLExpr c ++ findCallsInLExpr t ++ findCallsInLExpr f+ HsDo _ _ (L _ stmts) -> concatMap (\(L _ s) -> findCallsInStmt s) stmts+ ExplicitList _ exprs -> concatMap findCallsInLExpr exprs+ XExpr (WrapExpr (HsWrap _ inner)) -> findCallsInExpr sp inner+#if MIN_VERSION_ghc(9, 10, 0)+ XExpr (ExpandedThingTc _ inner) -> findCallsInExpr sp inner+#endif+ _ -> []++-- | Try to extract the file path from a mkStatement call.+-- After rewrite, the expression is:+-- mkStatement sqlStr oidsLit colsLit pathStr+-- Which in the AST is a chain of HsApp:+-- (((mkStatement `app` sql) `app` oids) `app` cols) `app` path+-- We collect all args from a left-nested application spine,+-- check the head is mkStatement, and take the 4th arg as the path.+extractMkStatementCall :: HsExpr GhcTc -> Maybe String+extractMkStatementCall expr = case collectArgs expr of+ (f, [_sql, _oids, _cols, path]) | isMkStatementExpr f ->+ extractStringLit (unLHsExpr path)+ _ -> Nothing++-- | Collect the function and arguments from a left-nested application spine.+-- (((f a1) a2) a3) → (f, [a1, a2, a3])+-- Uses reverse-accumulate internally to avoid O(n²) from repeated (++).+collectArgs :: HsExpr GhcTc -> (HsExpr GhcTc, [LHsExpr GhcTc])+collectArgs = go []+ where+ go !acc (HsApp _ (L _ f) arg) = go (arg : acc) f+ go !acc (XExpr (WrapExpr (HsWrap _ inner))) = go acc inner+ go !acc other = (other, acc) -- acc is already in correct order+ -- because we prepend as we peel from the outside in:+ -- (((f a1) a2) a3) → go [] expr → go [a3] (f a1 a2) → go [a2,a3] (f a1) → go [a1,a2,a3] f++unLHsExpr :: LHsExpr GhcTc -> HsExpr GhcTc+unLHsExpr (L _ e) = e++isMkStatementExpr :: HsExpr GhcTc -> Bool+isMkStatementExpr (HsVar _ (L _ var)) = isMkStatementName var+isMkStatementExpr (XExpr (WrapExpr (HsWrap _ inner))) = isMkStatementExpr inner+isMkStatementExpr _ = False++isMkStatementName :: Var -> Bool+isMkStatementName var =+ occNameString (nameOccName (varName var)) == "mkStatement"++findCallsInStmt :: StmtLR GhcTc GhcTc (LHsExpr GhcTc) -> [(SrcSpan, String)]+findCallsInStmt (BodyStmt _ body _ _) = findCallsInLExpr body+findCallsInStmt (BindStmt _ _ body) = findCallsInLExpr body+findCallsInStmt _ = []++isQueryFileExpr :: HsExpr GhcTc -> Bool+isQueryFileExpr (HsVar _ (L _ var)) = isQueryFileName var+isQueryFileExpr (XExpr (WrapExpr (HsWrap _ inner))) = isQueryFileExpr inner+isQueryFileExpr _ = False++isQueryFileName :: Var -> Bool+isQueryFileName var =+ let occ = occNameString (nameOccName (varName var))+ in occ == "queryFile" || occ == "queryFileAs" || occ == "query"++extractStringLit :: HsExpr GhcTc -> Maybe String+extractStringLit (HsLit _ (HsString _ fs)) = Just (unpackFS fs)+extractStringLit (HsOverLit _ (OverLit _ (HsIsString _ fs))) = Just (unpackFS fs)+extractStringLit (XExpr (WrapExpr (HsWrap _ inner))) = extractStringLit inner+extractStringLit _ = Nothing
+ src/Valiant/Plugin/TypeMap.hs view
@@ -0,0 +1,29 @@+-- | Map Haskell type names from cache metadata to GHC Type values.+module Valiant.Plugin.TypeMap+ ( resolveParamType+ , resolveResultType+ , typeNameToString+ ) where++import Data.Text (Text)+import Data.Text qualified as T+import Valiant.Plugin.Cache (CacheColumn (..), CacheParam (..))++-- | Build the expected parameter type description from cache metadata.+-- Returns a human-readable type string for comparison against the user's type.+resolveParamType :: [CacheParam] -> Text+resolveParamType [] = "()"+resolveParamType [p] = cpHaskellType p+resolveParamType ps = "(" <> T.intercalate ", " (map cpHaskellType ps) <> ")"++-- | Build the expected result type description from cache metadata.+resolveResultType :: [CacheColumn] -> Text+resolveResultType [] = "()"+resolveResultType [c] = ccHaskellType c+resolveResultType cs = "(" <> T.intercalate ", " (map ccHaskellType cs) <> ")"++-- | Convert a GHC Type to a simple string representation for comparison.+-- This is a simplified comparison that works at the text level rather than+-- requiring full GHC Type resolution.+typeNameToString :: Text -> Text+typeNameToString = id
+ src/Valiant/Plugin/Verify.hs view
@@ -0,0 +1,156 @@+-- | Verify that user type signatures match cached query metadata.+module Valiant.Plugin.Verify+ ( verifyQueryFile+ ) where++import Data.List.NonEmpty qualified as NE+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Core.TyCon qualified as TyCon+import GHC.Core.Type (Type, splitTyConApp_maybe)+import GHC.Plugins (showSDocUnsafe, ppr, TyCon, tyConName, nameOccName, occNameString)+import GHC.Tc.Utils.Monad (TcM)+import GHC.Types.SrcLoc (SrcSpan)+import Valiant.Plugin.Cache (CacheColumn (..), CacheEntry (..), CacheParam (..))+import Valiant.Plugin.Errors+import Valiant.Plugin.Traverse (QueryFileCall (..))++-- | Verify a queryFile call against its cache entry.+-- Emits compile errors if the types don't match.+verifyQueryFile :: QueryFileCall -> CacheEntry -> TcM ()+verifyQueryFile call entry = do+ let bindTy = qfcBindType call+ srcSpan = qfcSrcSpan call+ path = ceFile entry++ -- Try to decompose the type as Statement p r+ case decomposeStatementType bindTy of+ Nothing ->+ -- The binding type is not `Statement p r`. This happens when:+ -- 1. The user wrote a type hole `_` — GHC will infer the type from+ -- mkStatement's constraints, which is correct behavior.+ -- 2. No type signature was given — GHC infers from the rewritten+ -- mkStatement call, which already encodes the correct types.+ -- 3. The type is something other than Statement entirely — this will+ -- be caught by GHC's own typechecker when it tries to unify with+ -- mkStatement's return type, so we don't need to emit our own error.+ -- In all cases, skipping plugin validation is the right thing to do.+ pure ()+ Just (paramTy, resultTy) -> do+ -- Verify parameter types+ verifyParams srcSpan path paramTy (ceParams entry)+ -- Verify result types+ verifyResult srcSpan path resultTy (ceColumns entry)++-- | Decompose a type into (paramType, resultType) if it's Statement p r.+decomposeStatementType :: Type -> Maybe (Type, Type)+decomposeStatementType ty = do+ (tyCon, args) <- splitTyConApp_maybe ty+ let tcName = occNameString (nameOccName (tyConName tyCon))+ case args of+ [a, b] | tcName == "Statement" -> Just (a, b)+ _ -> Nothing++-- | Verify parameter types match.+verifyParams :: SrcSpan -> FilePath -> Type -> [CacheParam] -> TcM ()+verifyParams srcSpan path paramTy params = do+ let expectedArity = length params+ actualTypes = decomposeType paramTy+ actualArity = length actualTypes++ -- Check arity+ if expectedArity == 0 && isUnitType paramTy+ then pure () -- () matches 0 params+ else+ if actualArity /= expectedArity+ then errParamCountMismatch srcSpan path expectedArity actualArity params+ else do+ -- Check individual types+ let expected = map cpHaskellType params+ actual = map typeToText actualTypes+ mapM_ (checkParamType srcSpan path) (zip3 [1 ..] expected actual)++checkParamType :: SrcSpan -> FilePath -> (Int, Text, Text) -> TcM ()+checkParamType srcSpan path (idx, expected, actual)+ | matchesParamTypeText expected actual = pure ()+ | otherwise = errParamTypeMismatch srcSpan path idx expected actual++-- | Verify result types match.+verifyResult :: SrcSpan -> FilePath -> Type -> [CacheColumn] -> TcM ()+verifyResult srcSpan path resultTy cols = do+ let expectedArity = length cols+ actualTypes = decomposeType resultTy+ actualArity = length actualTypes++ if expectedArity == 0 && isUnitType resultTy+ then pure ()+ else+ if actualArity /= expectedArity+ then errColumnCountMismatch srcSpan path expectedArity actualArity cols+ else do+ let mismatches =+ [ (c, actual, matchesTypeText (ccHaskellType c) actual)+ | (c, ty) <- zip cols actualTypes+ , let actual = typeToText ty+ ]+ if all (\(_, _, ok) -> ok) mismatches+ then pure ()+ else errResultTypeMismatch srcSpan path mismatches++-- Helpers -----------------------------------------------------------------++-- | Decompose a type into its constituent parts.+-- Unit type () -> []+-- Single type T -> [T]+-- Tuple (A, B, C) -> [A, B, C]+decomposeType :: Type -> [Type]+decomposeType ty = case splitTyConApp_maybe ty of+ Just (tc, args)+ | isTupleTyCon tc -> args+ | isUnitTyCon tc -> []+ _ -> [ty] -- single type++-- | Convert a GHC Type to a text representation for comparison.+typeToText :: Type -> Text+typeToText ty = T.pack (showSDocUnsafe (ppr ty))++-- | Check if a type is the unit type ().+isUnitType :: Type -> Bool+isUnitType ty = case splitTyConApp_maybe ty of+ Just (tc, []) -> isUnitTyCon tc+ _ -> False++isUnitTyCon :: TyCon -> Bool+isUnitTyCon tc = occNameString (nameOccName (tyConName tc)) == "()"+ || TyCon.isUnboxedTupleTyCon tc && TyCon.tyConArity tc == 0++isTupleTyCon :: TyCon -> Bool+isTupleTyCon = TyCon.isTupleTyCon++-- | Compare expected type text from cache with actual type text from GHC.+-- This does a normalized comparison to handle differences in qualification.+matchesTypeText :: Text -> Text -> Bool+matchesTypeText expected actual =+ normalize expected == normalize actual++-- | Like 'matchesTypeText' but for parameters: allows @Maybe T@ to match @T@.+-- This is valid because Haskell's @Maybe@ encodes as SQL NULL, and Postgres+-- doesn't prevent NULL values in parameters (the column constraint enforces it).+matchesParamTypeText :: Text -> Text -> Bool+matchesParamTypeText expected actual =+ matchesTypeText expected actual+ || matchesTypeText expected (stripMaybe actual)+ where+ stripMaybe t = case T.words (normalize t) of+ ("Maybe" : rest) -> T.unwords rest+ _ -> t++normalize :: Text -> Text+normalize = T.strip . stripQualifiers++stripQualifiers :: Text -> Text+stripQualifiers t =+ -- "Data.Int.Int32" -> "Int32", "Maybe Data.Text.Text" -> "Maybe Text"+ T.unwords [lastPart w | w <- T.words t]+ where+ lastPart w = maybe w NE.last (NE.nonEmpty (T.splitOn "." w))
+ test/Main.hs view
@@ -0,0 +1,12 @@+module Main where++import Valiant.Plugin.CacheSpec qualified as CacheSpec+import Valiant.Plugin.ConfigSpec qualified as ConfigSpec+import Valiant.Plugin.ErrorCaseSpec qualified as ErrorCaseSpec+import Test.Hspec++main :: IO ()+main = hspec $ do+ describe "Valiant.Plugin.Config" ConfigSpec.spec+ describe "Valiant.Plugin.Cache" CacheSpec.spec+ describe "Valiant.Plugin.ErrorCases" ErrorCaseSpec.spec
+ test/Valiant/Plugin/CacheSpec.hs view
@@ -0,0 +1,48 @@+module Valiant.Plugin.CacheSpec (spec) where++import Valiant.Plugin.Cache+import System.Directory (doesFileExist)+import System.IO.Temp (withSystemTempDirectory)+import Test.Hspec++spec :: Spec+spec = do+ describe "cacheFileName" $ do+ it "produces the expected format" $ do+ cacheFileName "users/find_by_id.sql" "a1b2c3d4e5f6"+ `shouldBe` "users-find_by_id-a1b2c3d4e5f6.json"++ it "handles nested paths" $ do+ cacheFileName "admin/reports/monthly.sql" "abcdef012345"+ `shouldBe` "admin-reports-monthly-abcdef012345.json"++ it "handles single-level paths" $ do+ cacheFileName "query.sql" "abc123abc123"+ `shouldBe` "query-abc123abc123.json"++ describe "findCacheFile" $ do+ it "returns Nothing for non-existent cache directory" $ do+ result <- findCacheFile "/tmp/valiant-nonexistent-cache-dir" "test.sql" "abc123"+ result `shouldBe` Nothing++ it "returns Nothing when no matching file exists" $ do+ withSystemTempDirectory "valiant-cache-test" $ \tmpDir -> do+ result <- findCacheFile tmpDir "test.sql" "abc123"+ result `shouldBe` Nothing++ describe "readCacheEntry" $ do+ it "reads an actual .valiant cache file written by the CLI" $ do+ -- Tests compatibility between CLI-written cache and plugin reader+ let cacheFile = "/Users/joshburgess/code/valiant/.valiant/posts-find_by_id-b63f2b90e455.json"+ exists <- doesFileExist cacheFile+ if not exists+ then pendingWith "No .valiant cache files available (run valiant prepare first)"+ else do+ result <- readCacheEntry cacheFile+ case result of+ Right entry -> do+ ceFile entry `shouldBe` "posts/find_by_id.sql"+ ceVersion entry `shouldBe` "0.1.0"+ length (ceParams entry) `shouldBe` 1+ length (ceColumns entry) `shouldSatisfy` (> 0)+ Left err -> expectationFailure $ "Failed to parse cache file: " <> err
+ test/Valiant/Plugin/ConfigSpec.hs view
@@ -0,0 +1,40 @@+module Valiant.Plugin.ConfigSpec (spec) where++import Valiant.Plugin.Config+import Test.Hspec++spec :: Spec+spec = do+ describe "parseOptions" $ do+ it "returns defaults for empty options" $ do+ let cfg = parseOptions []+ pcSqlDir cfg `shouldBe` "sql"+ pcCacheDir cfg `shouldBe` ".valiant"+ pcOffline cfg `shouldBe` False++ it "parses sql-dir" $ do+ let cfg = parseOptions ["sql-dir=queries"]+ pcSqlDir cfg `shouldBe` "queries"++ it "parses cache-dir" $ do+ let cfg = parseOptions ["cache-dir=.cache"]+ pcCacheDir cfg `shouldBe` ".cache"++ it "parses offline=true" $ do+ let cfg = parseOptions ["offline=true"]+ pcOffline cfg `shouldBe` True++ it "parses offline=false" $ do+ let cfg = parseOptions ["offline=false"]+ pcOffline cfg `shouldBe` False++ it "handles multiple options" $ do+ let cfg = parseOptions ["sql-dir=q", "cache-dir=c", "offline=true"]+ pcSqlDir cfg `shouldBe` "q"+ pcCacheDir cfg `shouldBe` "c"+ pcOffline cfg `shouldBe` True++ it "ignores unknown options" $ do+ let cfg = parseOptions ["unknown=value", "sql-dir=q"]+ pcSqlDir cfg `shouldBe` "q"+ pcCacheDir cfg `shouldBe` ".valiant"
+ test/Valiant/Plugin/ErrorCaseSpec.hs view
@@ -0,0 +1,227 @@+module Valiant.Plugin.ErrorCaseSpec (spec) where++import Data.List (isInfixOf)+import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory)+import System.Exit (ExitCode (..))+import System.Process (readProcessWithExitCode)+import Test.Hspec++spec :: Spec+spec = beforeAll_ (createDirectoryIfMissing True "/tmp/valiant-error-tests") $ do+ describe "VALIANT-001: SQL file not found" $ do+ it "reports missing .sql file with error code" $ do+ (code, _, stderr) <- compileWith defaultOpts+ "module E001 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \bad :: Statement Int32 Int32\n\+ \bad = queryFile \"users/nonexistent.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-001" `isInfixOf`)+ stderr `shouldSatisfy` ("SQL file not found" `isInfixOf`)++ describe "VALIANT-002: Cache stale or missing" $ do+ it "reports missing cache for valid .sql file" $ do+ (code, _, stderr) <- compileWith defaultOpts { optCacheDir = "/tmp/valiant-nonexistent-cache" }+ "module E002 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \bad :: Statement Int32 Int32\n\+ \bad = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-002" `isInfixOf`)+ stderr `shouldSatisfy` ("Query not prepared" `isInfixOf`)++ describe "VALIANT-005: Parameter type mismatch" $ do+ it "reports wrong parameter type" $ do+ -- find_by_id expects Int32 param, we give Text+ (code, _, stderr) <- compileWith defaultOpts+ "module E005 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \import Data.Time (UTCTime)\n\+ \bad :: Statement Text (Int32, Text, Maybe Text, Bool, UTCTime)\n\+ \bad = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-005" `isInfixOf`)+ stderr `shouldSatisfy` ("Parameter type mismatch" `isInfixOf`)++ describe "VALIANT-006: Parameter count mismatch" $ do+ it "reports wrong number of parameters" $ do+ -- find_by_id expects 1 param, we give 2+ (code, _, stderr) <- compileWith defaultOpts+ "module E006 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \import Data.Time (UTCTime)\n\+ \bad :: Statement (Int32, Text) (Int32, Text, Maybe Text, Bool, UTCTime)\n\+ \bad = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-006" `isInfixOf`)+ stderr `shouldSatisfy` ("Parameter count mismatch" `isInfixOf`)++ describe "VALIANT-004: Column count mismatch" $ do+ it "reports wrong number of result columns" $ do+ -- find_by_id returns 5 columns, we declare 2+ (code, _, stderr) <- compileWith defaultOpts+ "module E004 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \bad :: Statement Int32 (Int32, Text)\n\+ \bad = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-004" `isInfixOf`)+ stderr `shouldSatisfy` ("Column count mismatch" `isInfixOf`)++ describe "VALIANT-003: Result type mismatch" $ do+ it "reports wrong column type" $ do+ -- find_by_id col 3 (email) is Maybe Text, we say Text (non-nullable)+ (code, _, stderr) <- compileWith defaultOpts+ "module E003 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \import Data.Time (UTCTime)\n\+ \bad :: Statement Int32 (Int32, Text, Text, Bool, UTCTime)\n\+ \bad = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitFailure 1+ stderr `shouldSatisfy` ("VALIANT-003" `isInfixOf`)+ stderr `shouldSatisfy` ("Result type mismatch" `isInfixOf`)++ describe "Inline query" $ do+ it "reports error for inline SQL with no cache" $ do+ -- query "..." with no matching cache entry+ (code, _, stderr) <- compileWith defaultOpts+ "module InlineNoCache where\n\+ \import Valiant.Statement (Statement, query)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \bad :: Statement Int32 (Int32, Text)\n\+ \bad = query \"SELECT id, name FROM nonexistent WHERE id = $1\"\n"+ code `shouldBe` ExitFailure 1+ -- Plugin detects the call and reports an error+ stderr `shouldSatisfy` (\s -> "VALIANT-001" `isInfixOf` s || "VALIANT-002" `isInfixOf` s)++ it "rewrites inline query when cache exists" $ do+ -- This test creates a temporary cache file matching the inline SQL,+ -- then compiles. The SQL matches users/find_by_id.sql content but+ -- without the trailing newline, so we need to use the exact SQL+ -- from the cache file.+ -- For now, test that the plugin at least processes the query call+ -- (doesn't crash with ValiantPluginRequired TypeError).+ (_, _, stderr) <- compileWith defaultOpts+ "module InlineRewrite where\n\+ \import Valiant.Statement (Statement, query)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \bad :: Statement Int32 (Int32, Text)\n\+ \bad = query \"SELECT id, name FROM users WHERE id = $1\"\n"+ -- Should NOT get the ValiantPluginRequired TypeError+ -- (proves the rewrite phase ran)+ stderr `shouldSatisfy` (not . ("requires the Valiant.Plugin" `isInfixOf`))++ describe "Successful compilation" $ do+ it "compiles correct positional params" $ do+ (code, _, _) <- compileWith defaultOpts+ "module Good1 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \import Data.Time (UTCTime)\n\+ \q :: Statement Int32 (Int32, Text, Maybe Text, Bool, UTCTime)\n\+ \q = queryFile \"users/find_by_id.sql\"\n"+ code `shouldBe` ExitSuccess++ it "compiles named params query" $ do+ (code, _, _) <- compileWith defaultOpts+ "module Good2 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \q :: Statement (Text, Bool) (Int32, Text, Maybe Text)\n\+ \q = queryFile \"users/find_by_name_and_status.sql\"\n"+ code `shouldBe` ExitSuccess++ it "compiles unit result (INSERT)" $ do+ (code, _, _) <- compileWith defaultOpts+ "module Good3 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Text (Text)\n\+ \q :: Statement (Text, Maybe Text) ()\n\+ \q = queryFile \"users/insert.sql\"\n"+ code `shouldBe` ExitSuccess++ it "compiles no-param query" $ do+ (code, _, _) <- compileWith defaultOpts+ "module Good4 where\n\+ \import Valiant.Statement (Statement, queryFile)\n\+ \import Data.Int (Int32)\n\+ \import Data.Text (Text)\n\+ \q :: Statement () (Int32, Text)\n\+ \q = queryFile \"users/list_all.sql\"\n"+ code `shouldBe` ExitSuccess++-- Helpers -----------------------------------------------------------------++data CompileOpts = CompileOpts+ { optSqlDir :: String+ , optCacheDir :: String+ }++-- | Default options. sql-dir and cache-dir are set to absolute paths+-- in compileWith using getCurrentDirectory.+defaultOpts :: CompileOpts+defaultOpts = CompileOpts+ { optSqlDir = ""+ , optCacheDir = ""+ }++compileWith :: CompileOpts -> String -> IO (ExitCode, String, String)+compileWith opts src = do+ -- Extract module name from source to use as unique filename+ let modName = case words src of+ ("module" : name : _) -> name+ _ -> "Test"+ tmpFile = "/tmp/valiant-error-tests/" <> modName <> ".hs"+ outDir = "/tmp/valiant-error-tests/out-" <> modName+ createDirectoryIfMissing True outDir+ writeFile tmpFile src+ -- Resolve paths relative to the project root.+ -- cabal test may run from the package subdir, so we go up to find sql/ and .valiant/.+ projRoot <- findProjectRoot+ let sqlDir = if null (optSqlDir opts) then projRoot <> "/sql" else optSqlDir opts+ cacheDir = if null (optCacheDir opts) then projRoot <> "/.valiant" else optCacheDir opts+ args =+ [ "exec", "--"+ , "ghc"+ , "-package-db", projRoot <> "/dist-newstyle/packagedb/ghc-9.10.3"+ , "-package", "valiant"+ , "-package", "valiant-plugin"+ , "-fplugin=Valiant.Plugin"+ , "-fplugin-opt=Valiant.Plugin:sql-dir=" <> sqlDir+ , "-fplugin-opt=Valiant.Plugin:cache-dir=" <> cacheDir+ , "-c", "-no-link"+ , "-outputdir", outDir+ , "-fforce-recomp"+ , tmpFile+ ]+ readProcessWithExitCode "cabal" args ""++-- | Find the project root by looking for cabal.project.+findProjectRoot :: IO FilePath+findProjectRoot = go =<< getCurrentDirectory+ where+ go dir = do+ exists <- doesFileExist (dir <> "/cabal.project")+ if exists+ then pure dir+ else let parent = takeDirectory dir+ in if parent == dir+ then pure dir -- give up at filesystem root+ else go parent++takeDirectory :: FilePath -> FilePath+takeDirectory = reverse . dropWhile (/= '/') . drop 1 . reverse
+ valiant-plugin.cabal view
@@ -0,0 +1,130 @@+cabal-version: 3.0+name: valiant-plugin+version: 0.1.0.0+synopsis: Compile-time checked SQL for Haskell, GHC source plugin+description:+ GHC source plugin that validates @queryFile@ calls at compile time+ by reading cached metadata from the @.valiant/@ directory.+license: BSD-3-Clause+license-file: LICENSE+author: Josh Burgess+maintainer: joshburgess.webdev@gmail.com+category: Database+homepage: https://github.com/joshburgess/valiant+bug-reports: https://github.com/joshburgess/valiant/issues+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md+tested-with: GHC ==9.10.3++source-repository head+ type: git+ location: https://github.com/joshburgess/valiant+ subdir: plugin++flag werror+ description: Enable -Werror for development builds.+ default: False+ manual: True++common warnings+ ghc-options: -Wall -Wcompat -Wno-unticked-promoted-constructors -funbox-strict-fields -fspecialise-aggressively+ if flag(werror)+ ghc-options: -Werror++library+ import: warnings+ hs-source-dirs: src+ default-language: GHC2021+ default-extensions:+ DerivingStrategies+ LambdaCase+ OverloadedStrings+ RecordWildCards+ StrictData++ exposed-modules:+ Valiant.Plugin+ Valiant.Plugin.Cache+ Valiant.Plugin.Config++ -- Internal modules. Exposed only because the test suite imports a+ -- subset; treat as private and subject to change without notice.+ other-modules:+ Valiant.Plugin.Compat+ Valiant.Plugin.Errors+ Valiant.Plugin.Hash+ Valiant.Plugin.Rewrite+ Valiant.Plugin.Traverse+ Valiant.Plugin.TypeMap+ Valiant.Plugin.Verify++ build-depends:+ , base >=4.17 && <5+ , bytestring >=0.11 && <0.13+ , text >=2.0 && <2.2+ , containers >=0.6 && <0.8+ , filepath >=1.4 && <1.6+ , directory >=1.3 && <1.4+ , aeson >=2.1 && <2.3+ , cryptohash-sha256 >=0.11 && <0.12+ , ghc >=9.6 && <9.12+ , time >=1.12 && <1.15+ , edit-distance >=0.2 && <0.3++test-suite valiant-plugin-test+ import: warnings+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ default-language: GHC2021+ default-extensions:+ OverloadedStrings++ ghc-options: -rtsopts "-with-rtsopts=-K8K"++ other-modules:+ Valiant.Plugin.ConfigSpec+ Valiant.Plugin.CacheSpec+ Valiant.Plugin.ErrorCaseSpec++ build-depends:+ , base >=4.17 && <5+ , aeson+ , bytestring+ , directory+ , filepath+ , hspec >=2.11 && <2.13+ , valiant-plugin+ , process >=1.6 && <1.8+ , temporary >=1.3 && <1.4+ , text++-- End-to-end test: compiles a module with the plugin loaded.+-- Validates that queryFile calls are rewritten and type-checked.+-- Requires: valiant prepare to have been run (cache files in ../.valiant/).+test-suite valiant-plugin-e2e+ import: warnings+ type: exitcode-stdio-1.0+ hs-source-dirs: e2e+ main-is: Main.hs+ default-language: GHC2021+ default-extensions:+ OverloadedStrings++ other-modules:+ PluginE2E++ ghc-options:+ -fplugin=Valiant.Plugin+ -fplugin-opt=Valiant.Plugin:sql-dir=../sql+ -fplugin-opt=Valiant.Plugin:cache-dir=../.valiant+ -rtsopts "-with-rtsopts=-K8K"++ build-depends:+ , base >=4.17 && <5+ , valiant+ , valiant-plugin+ , text+ , time