git.iko.soy/rowtype-yoga/purescript-yoga-postgres
on main help sign in
Verify all 70 compile-fail tests pass
commit2110995f808a6da8f6e75fc596fb9f6122e1f0c5 authorMark <mark.eibes@gmail.com> dateSun 15 Feb 2026, 15:28 (8 months ago) parentc2a9948
3 files changed+59−1
compare with main
unifiedsplit
compile-fail-tests/UnclosedStringLiteral.purs+20 src/Yoga/Postgres/Schema.purs+32−1 test/Schema.purs+7
compile-fail-tests/UnclosedStringLiteral.pursnew file+20
@@ -0,0 +1,20 @@
1+-- EXPECT: Unclosed string literal in WHERE clause
2+module Test.CompileFail.UnclosedStringLiteral where
3+
4+import Prelude
5+import Data.Maybe (Maybe(..))
6+import Type.Function (type (#))
7+import Type.Proxy (Proxy(..))
8+import Yoga.Postgres.Schema
9+
10+type UsersTable = Table "users"
11+ ( id :: Int # PrimaryKey # AutoIncrement
12+ , name :: String
13+ , email :: String # Unique
14+ , age :: Maybe Int
15+ )
16+
17+usersTable :: Proxy UsersTable
18+usersTable = Proxy
19+
20+bad = from usersTable # selectAll # where_ @"name = 'unclosed"
src/Yoga/Postgres/Schema.purs+32−1
@@ -415,6 +415,31 @@ class SkipSpacesGo head tail result | head tail -> result
415415instance SkipSpaces tail result => SkipSpacesGo " " tail result
416416else instance Symbol.Cons head tail result => SkipSpacesGo head tail result
417417
418+-- Skip a string literal: consume chars until closing single quote
419+class SkipStringLiteral :: Symbol -> Symbol -> Constraint
420+class SkipStringLiteral sym rest | sym -> rest
421+
422+instance Fail (Text "Unclosed string literal in WHERE clause") => SkipStringLiteral "" rest
423+else instance
424+ ( Symbol.Cons h t sym
425+ , SkipStringLiteralGo h t rest
426+ ) =>
427+ SkipStringLiteral sym rest
428+
429+class SkipStringLiteralGo :: Symbol -> Symbol -> Symbol -> Constraint
430+class SkipStringLiteralGo head tail rest | head tail -> rest
431+
432+-- Closing quote: done
433+instance SkipStringLiteralGo "'" tail tail
434+-- End of string without closing quote
435+else instance Fail (Text "Unclosed string literal in WHERE clause") => SkipStringLiteralGo h "" rest
436+-- Any other char: skip and continue
437+else instance
438+ ( Symbol.Cons nextH nextT tail
439+ , SkipStringLiteralGo nextH nextT rest
440+ ) =>
441+ SkipStringLiteralGo h tail rest
442+
418443-- Extract the first word from a Symbol (up to space or end)
419444class ExtractWord :: Symbol -> Symbol -> Symbol -> Constraint
420445class ExtractWord sym word rest | sym -> word rest
@@ -1277,7 +1302,13 @@ else instance (FlushWhereWord acc currentType tables paramsIn currentType' param
12771302else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "!" tail acc currentType tables paramsIn paramsOut
12781303else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "(" tail acc currentType tables paramsIn paramsOut
12791304else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ")" tail acc currentType tables paramsIn paramsOut
1280−else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "'" tail acc currentType tables paramsIn paramsOut
1305+-- String literal: flush word, skip until closing quote
1306+else instance
1307+ ( FlushWhereWord acc currentType tables paramsIn currentType' paramsOut'
1308+ , SkipStringLiteral tail rest
1309+ , ParseWhereContinue rest currentType' tables paramsOut' paramsOut
1310+ ) =>
1311+ ParseWhereGo "'" tail acc currentType tables paramsIn paramsOut
12811312else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "@" tail acc currentType tables paramsIn paramsOut
12821313else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo "?" tail acc currentType tables paramsIn paramsOut
12831314else instance (FlushWhereWord acc currentType tables paramsIn currentType' paramsOut', ParseWhereContinue tail currentType' tables paramsOut' paramsOut) => ParseWhereGo ":" tail acc currentType tables paramsIn paramsOut
test/Schema.purs+7
@@ -176,6 +176,13 @@ typedWhereComplex
176176 _
177177typedWhereComplex = from usersTable # selectAll # where_ @"name = $name AND age > $age"
178178
179+typedWhereStringLiteral
180+ :: Q _
181+ (age :: Maybe Int, email :: String, id :: Int, name :: String)
182+ (status :: String)
183+ _
184+typedWhereStringLiteral = from usersTable # selectAll # where_ @"name = $status AND email != 'test@example.com'"
185+
179186typedSelectColsWhere
180187 :: Q _
181188 (name :: String)