@@ -2,14 +2,17 @@ module Yoga.Postgres.Schema where
22
33import Prelude
44
5−import Data.Array (intercalate, mapWithIndex)
5+import Data.Array (intercalate, mapWithIndex, filter)
6+import Data.String as String
67import Data.Maybe (Maybe)
78import Data.Reflectable (class Reflectable, reflectType)
89import Data.Symbol (class IsSymbol, reflectSymbol)
910import Data.Tuple.Nested (type (/\))
11+import Prim.Row (class Cons) as Row
1012import Prim.RowList as RL
1113import Prim.RowList (class RowToList)
1214import Prim.Symbol (class Cons, class Append) as Symbol
15+import Prim.TypeError (class Fail, Beside, Text, Quote)
1316import Type.Proxy (Proxy(..))
1417
1518-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -315,6 +318,111 @@ instance
315318-- Builder-style query API
316319-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
317320
321+-- Type-level column name validation
322+-- Validates that every comma-separated name in a Symbol exists in the table's row
323+
324+class ValidateColumns :: Symbol -> Row Type -> Constraint
325+class ValidateColumns sym cols
326+
327+class ValidateColumnsGo :: Symbol -> Symbol -> Symbol -> Row Type -> Constraint
328+class ValidateColumnsGo head tail acc cols
329+
330+-- Empty string: nothing to validate
331+instance ValidateColumns "" cols
332+
333+-- Non-empty: start character-by-character walk
334+else instance
335+ ( Symbol.Cons head tail sym
336+ , ValidateColumnsGo head tail "" cols
337+ ) =>
338+ ValidateColumns sym cols
339+
340+-- Hit a comma: validate accumulated name, skip to next
341+instance
342+ ( ValidateColumn acc cols
343+ , SkipSpaces tail rest
344+ , ValidateColumns rest cols
345+ ) =>
346+ ValidateColumnsGo "," tail acc cols
347+
348+-- Hit a space: validate accumulated name, skip spaces then expect comma or end
349+else instance
350+ ( SkipSpaces tail rest
351+ , ValidateAfterSpace acc rest cols
352+ ) =>
353+ ValidateColumnsGo " " tail acc cols
354+
355+-- End of string (no more chars): validate final accumulated name
356+else instance
357+ ( Symbol.Append acc h acc'
358+ , ValidateColumn acc' cols
359+ ) =>
360+ ValidateColumnsGo h "" acc cols
361+
362+-- Regular character: append to accumulator, continue
363+else instance
364+ ( Symbol.Append acc h acc'
365+ , Symbol.Cons nextH nextT tail
366+ , ValidateColumnsGo nextH nextT acc' cols
367+ ) =>
368+ ValidateColumnsGo h tail acc cols
369+
370+-- After a space inside a name: either comma (end of name) or more text
371+class ValidateAfterSpace :: Symbol -> Symbol -> Row Type -> Constraint
372+class ValidateAfterSpace acc rest cols
373+
374+-- Rest is empty: validate the accumulated name
375+instance ValidateColumn acc cols => ValidateAfterSpace acc "" cols
376+
377+-- Rest starts with comma: validate name, continue parsing
378+else instance
379+ ( ValidateColumn acc cols
380+ , Symbol.Cons "," tail rest
381+ , SkipSpaces tail rest'
382+ , ValidateColumns rest' cols
383+ ) =>
384+ ValidateAfterSpace acc rest cols
385+
386+-- Skip leading spaces
387+class SkipSpaces :: Symbol -> Symbol -> Constraint
388+class SkipSpaces sym result | sym -> result
389+
390+instance SkipSpaces "" ""
391+else instance
392+ ( Symbol.Cons head tail sym
393+ , SkipSpacesGo head tail result
394+ ) =>
395+ SkipSpaces sym result
396+
397+class SkipSpacesGo :: Symbol -> Symbol -> Symbol -> Constraint
398+class SkipSpacesGo head tail result | head tail -> result
399+
400+instance SkipSpaces tail result => SkipSpacesGo " " tail result
401+else instance Symbol.Cons head tail result => SkipSpacesGo head tail result
402+
403+-- Validate a single column name exists in the row
404+class ValidateColumn :: Symbol -> Row Type -> Constraint
405+class ValidateColumn name cols
406+
407+instance
408+ ( Row.Cons name typ rest cols
409+ ) =>
410+ ValidateColumn name cols
411+
412+else instance
413+ ( Fail (Beside (Beside (Text "Column ") (Quote name)) (Text " does not exist in the table"))
414+ ) =>
415+ ValidateColumn name cols
416+
417+-- Reflect a comma-separated Symbol to Array String at value level
418+splitColumns :: forall sym. IsSymbol sym => Proxy sym -> Array String
419+splitColumns _ = reflectSymbol (Proxy :: Proxy sym)
420+ # String.split (String.Pattern ",")
421+ # map String.trim
422+ # filter (_ /= "")
423+
424+-- Query builder
425+
318426newtype Q :: Symbol -> Row Type -> Type
319427newtype Q name cols = Q String
320428
@@ -328,17 +436,21 @@ select
328436 :: forall @sel name cols
329437 . IsSymbol name
330438 => IsSymbol sel
439+ => ValidateColumns sel cols
331440 => Q name cols
332441 -> Q name cols
333442select _ = Q ("SELECT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> reflectSymbol (Proxy :: Proxy name))
334443
335444where_
336− :: forall @whr whrRL name cols
337− . RowToList whr whrRL
338− => WhereClauseRL whrRL
445+ :: forall @whr name cols
446+ . IsSymbol whr
447+ => ValidateColumns whr cols
339448 => Q name cols
340449 -> Q name cols
341−where_ (Q base) = Q (base <> " WHERE " <> intercalate " AND " (whereClauseRL (Proxy :: Proxy whrRL) 1))
450+where_ (Q base) = do
451+ let cols = splitColumns (Proxy :: Proxy whr)
452+ let conditions = cols # mapWithIndex \i col -> col <> " = $" <> show (i + 1)
453+ Q (base <> " WHERE " <> intercalate " AND " conditions)
342454
343455toSQL :: forall name cols. Q name cols -> String
344456toSQL (Q s) = s