@@ -2,16 +2,31 @@ module Yoga.ScyllaDB.Schema where
22
33import Prelude
44
5+import Control.Monad.Except (runExcept)
56import Data.Array (intercalate)
67import Data.DateTime (DateTime)
7−import Data.Maybe (Maybe)
8+import Data.Either (Either(..))
9+import Data.Foldable (foldl)
10+import Data.Map as Map
11+import Data.Maybe (Maybe(..))
12+import Data.Nullable (toNullable)
13+import Data.String.Regex as Regex
14+import Data.String.Regex.Flags as RegexFlags
815import Data.Symbol (class IsSymbol, reflectSymbol)
9−import Type.Function (type (#))
10−import Type.Proxy (Proxy(..))
11−import Type.RowList (class ListToRow)
12−import Prim.Boolean (True, False)
16+import Data.Traversable (traverse)
17+import Effect.Aff (Aff, throwError)
18+import Effect.Exception as Exception
19+import Foreign (Foreign, unsafeToForeign)
20+import Prim.Row as Row
1321import Prim.RowList as RL
1422import Prim.RowList (class RowToList)
23+import Prim.Symbol as Symbol
24+import Prim.TypeError (class Fail, Text)
25+import Record as Record
26+import Type.Proxy (Proxy(..))
27+import Type.RowList (class ListToRow)
28+import Unsafe.Coerce (unsafeCoerce)
29+import Yoga.JSON (class ReadForeign, readImpl)
1530import Yoga.ScyllaDB.ScyllaDB as Scylla
1631
1732-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
@@ -424,3 +439,665 @@ instance
424439 in
425440 if isKeyColumn (Proxy :: Proxy entry) then rest
426441 else [ reflectSymbol (Proxy :: Proxy name) ] <> rest
442+
443+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
444+-- Q type: Builder phantom type for CQL queries
445+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
446+
447+newtype Q :: Row (Row Type) -> Row Type -> Row Type -> Row Type -> Type
448+newtype Q tables result params stage = Q { sql :: String, values :: Array Foreign }
449+
450+toSQL :: forall tables result params stage. Q tables result params stage -> String
451+toSQL (Q q) = q.sql
452+
453+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
454+-- SingleTable: extract name and cols from a one-entry tables row
455+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
456+
457+class SingleTable :: Row (Row Type) -> Symbol -> Row Type -> Constraint
458+class SingleTable tables name cols | tables -> name cols
459+
460+instance
461+ ( RowToList tables (RL.Cons name cols RL.Nil)
462+ , IsSymbol name
463+ ) =>
464+ SingleTable tables name cols
465+
466+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
467+-- HasClause / HasAnyDML: stage constraints
468+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
469+
470+class HasClause :: Symbol -> Row Type -> Constraint
471+class HasClause label row
472+
473+instance Row.Cons label Unit rest row => HasClause label row
474+
475+class HasAnyDML :: Row Type -> Constraint
476+class HasAnyDML stage
477+
478+instance (RL.RowToList stage rl, HasAnyDMLRL rl) => HasAnyDML stage
479+
480+class HasAnyDMLRL :: RL.RowList Type -> Constraint
481+class HasAnyDMLRL rl
482+
483+instance HasAnyDMLRL (RL.Cons "select" Unit rest)
484+else instance HasAnyDMLRL (RL.Cons "set" Unit rest)
485+else instance HasAnyDMLRL (RL.Cons "delete" Unit rest)
486+else instance HasAnyDMLRL rest => HasAnyDMLRL (RL.Cons label typ rest)
487+else instance Fail (Text "WHERE requires a preceding SELECT, UPDATE (set), or DELETE") => HasAnyDMLRL RL.Nil
488+
489+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
490+-- FieldToCQLValue: convert a PureScript value to Foreign for CQL
491+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
492+
493+class FieldToCQLValue :: Type -> Constraint
494+class FieldToCQLValue a where
495+ fieldToCQLValue :: a -> Foreign
496+
497+instance FieldToCQLValue a => FieldToCQLValue (Maybe a) where
498+ fieldToCQLValue = toNullable >>> unsafeCoerce
499+else instance FieldToCQLValue DateTime where
500+ fieldToCQLValue = unsafeCoerce
501+else instance FieldToCQLValue Scylla.UUID where
502+ fieldToCQLValue = unsafeCoerce
503+else instance FieldToCQLValue a where
504+ fieldToCQLValue = unsafeCoerce
505+
506+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
507+-- RecordValuesRL: walk a RowList and extract values from a record
508+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
509+
510+class RecordValuesRL :: RL.RowList Type -> Row Type -> Constraint
511+class RecordValuesRL rl row where
512+ recordValuesRL :: Proxy rl -> { | row } -> Array Foreign
513+
514+instance RecordValuesRL RL.Nil row where
515+ recordValuesRL _ _ = []
516+
517+instance
518+ ( IsSymbol name
519+ , Row.Cons name typ rest row
520+ , FieldToCQLValue typ
521+ , RecordValuesRL tail row
522+ ) =>
523+ RecordValuesRL (RL.Cons name typ tail) row where
524+ recordValuesRL _ rec =
525+ [ fieldToCQLValue (Record.get (Proxy :: Proxy name) rec) ]
526+ <> recordValuesRL (Proxy :: Proxy tail) rec
527+
528+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
529+-- ColumnNamesRL: extract column names from a RowList
530+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
531+
532+class ColumnNamesRL :: RL.RowList Type -> Constraint
533+class ColumnNamesRL rl where
534+ columnNamesRL :: Proxy rl -> Array String
535+
536+instance ColumnNamesRL RL.Nil where
537+ columnNamesRL _ = []
538+
539+instance (IsSymbol name, ColumnNamesRL tail) => ColumnNamesRL (RL.Cons name typ tail) where
540+ columnNamesRL _ =
541+ [ reflectSymbol (Proxy :: Proxy name) ] <> columnNamesRL (Proxy :: Proxy tail)
542+
543+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
544+-- ValidateSetColumnsRL: ensure SET columns exist in the table
545+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
546+
547+class ValidateSetColumnsRL :: RL.RowList Type -> Row Type -> Constraint
548+class ValidateSetColumnsRL rl cols
549+
550+instance ValidateSetColumnsRL RL.Nil cols
551+
552+instance
553+ ( IsSymbol name
554+ , Row.Cons name colType rest cols
555+ , ValidateSetColumnsRL tail cols
556+ ) =>
557+ ValidateSetColumnsRL (RL.Cons name typ tail) cols
558+
559+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
560+-- Builder: from
561+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
562+
563+from
564+ :: forall name cols tables
565+ . IsSymbol name
566+ => Row.Cons name cols () tables
567+ => Proxy (Table name cols)
568+ -> Q tables () () ()
569+from _ = Q { sql: reflectSymbol (Proxy :: Proxy name), values: [] }
570+
571+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
572+-- Builder: selectAll
573+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
574+
575+selectAll
576+ :: forall tables name cols result r p stage stage'
577+ . SingleTable tables name cols
578+ => StripColumns cols result
579+ => Row.Lacks "select" stage
580+ => Row.Lacks "insert" stage
581+ => Row.Lacks "set" stage
582+ => Row.Lacks "delete" stage
583+ => Row.Lacks "where" stage
584+ => Row.Lacks "orderBy" stage
585+ => Row.Lacks "limit" stage
586+ => Row.Cons "select" Unit stage stage'
587+ => Q tables r p stage
588+ -> Q tables result p stage'
589+selectAll (Q q) = Q (q { sql = "SELECT * FROM " <> q.sql })
590+
591+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
592+-- Builder: delete
593+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
594+
595+delete
596+ :: forall tables name cols r p stage stage'
597+ . SingleTable tables name cols
598+ => IsSymbol name
599+ => Row.Lacks "select" stage
600+ => Row.Lacks "insert" stage
601+ => Row.Lacks "set" stage
602+ => Row.Lacks "delete" stage
603+ => Row.Cons "delete" Unit stage stage'
604+ => Q tables r p stage
605+ -> Q tables () () stage'
606+delete (Q _) = Q { sql: "DELETE FROM " <> reflectSymbol (Proxy :: Proxy name), values: [] }
607+
608+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
609+-- Builder SetClauseRL (for builder pattern — uses bare ?)
610+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
611+
612+class BuilderSetClauseRL :: RL.RowList Type -> Constraint
613+class BuilderSetClauseRL rl where
614+ builderSetClauseRL :: Proxy rl -> Array String
615+
616+instance BuilderSetClauseRL RL.Nil where
617+ builderSetClauseRL _ = []
618+
619+instance (IsSymbol name, BuilderSetClauseRL tail) => BuilderSetClauseRL (RL.Cons name typ tail) where
620+ builderSetClauseRL _ =
621+ [ reflectSymbol (Proxy :: Proxy name) <> " = ?" ]
622+ <> builderSetClauseRL (Proxy :: Proxy tail)
623+
624+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
625+-- Builder: insert
626+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
627+
628+insert
629+ :: forall tables name cols userRow userRowRL stage stage'
630+ . SingleTable tables name cols
631+ => RowToList userRow userRowRL
632+ => ColumnNamesRL userRowRL
633+ => RecordValuesRL userRowRL userRow
634+ => IsSymbol name
635+ => Row.Lacks "select" stage
636+ => Row.Lacks "insert" stage
637+ => Row.Lacks "set" stage
638+ => Row.Lacks "delete" stage
639+ => Row.Cons "insert" Unit stage stage'
640+ => { | userRow }
641+ -> Q tables () () stage
642+ -> Q tables () () stage'
643+insert rec (Q _) = Q { sql, values }
644+ where
645+ tableName = reflectSymbol (Proxy :: Proxy name)
646+ colNames = columnNamesRL (Proxy :: Proxy userRowRL)
647+ placeholders = map (const "?") colNames
648+ sql = "INSERT INTO " <> tableName
649+ <> " (" <> intercalate ", " colNames <> ")"
650+ <> " VALUES (" <> intercalate ", " placeholders <> ")"
651+ values = recordValuesRL (Proxy :: Proxy userRowRL) rec
652+
653+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
654+-- Builder: set (UPDATE)
655+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
656+
657+set
658+ :: forall tables name cols setRow setRL stage stage'
659+ . SingleTable tables name cols
660+ => RowToList setRow setRL
661+ => IsSymbol name
662+ => ValidateSetColumnsRL setRL cols
663+ => BuilderSetClauseRL setRL
664+ => RecordValuesRL setRL setRow
665+ => Row.Lacks "select" stage
666+ => Row.Lacks "insert" stage
667+ => Row.Lacks "set" stage
668+ => Row.Lacks "delete" stage
669+ => Row.Cons "set" Unit stage stage'
670+ => { | setRow }
671+ -> Q tables () () stage
672+ -> Q tables () () stage'
673+set rec (Q q) = Q { sql, values }
674+ where
675+ setClauses = builderSetClauseRL (Proxy :: Proxy setRL)
676+ sql = "UPDATE " <> q.sql <> " SET " <> intercalate ", " setClauses
677+ values = recordValuesRL (Proxy :: Proxy setRL) rec
678+
679+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
680+-- ParseWhere: extract $paramName tokens from WHERE clause
681+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
682+
683+class ParseWhere :: Symbol -> Row (Row Type) -> Row Type -> Constraint
684+class ParseWhere sym tables params | sym tables -> params
685+
686+instance
687+ ( Symbol.Cons h t sym
688+ , ParseWhereGo h t tables RL.Nil outRL
689+ , ListToRow outRL params
690+ ) =>
691+ ParseWhere sym tables params
692+
693+class ParseWhereGo :: Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
694+class ParseWhereGo head tail tables paramsIn paramsOut | head tail tables paramsIn -> paramsOut
695+
696+-- When we see $, collect the param name and resolve its type
697+instance
698+ ( CollectParamName rest "" paramName restAfter
699+ , SingleTable tables tableName cols
700+ , RowToList cols colsRL
701+ , ResolveParamType paramName colsRL typ
702+ , EndOrContinue restAfter tables (RL.Cons paramName typ paramsIn) paramsOut
703+ ) =>
704+ ParseWhereGo "$" rest tables paramsIn paramsOut
705+
706+-- End of string: done
707+else instance ParseWhereGo h "" tables paramsIn paramsIn
708+
709+-- Default: skip regular characters and continue
710+else instance
711+ ( Symbol.Cons h2 t2 rest
712+ , ParseWhereGo h2 t2 tables paramsIn paramsOut
713+ ) =>
714+ ParseWhereGo h rest tables paramsIn paramsOut
715+
716+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
717+-- CollectParamName: accumulate identifier chars after $
718+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
719+
720+class CollectParamName :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
721+class CollectParamName input acc name rest | input acc -> name rest
722+
723+instance CollectParamName "" acc acc ""
724+else instance
725+ ( Symbol.Cons h t input
726+ , CollectParamNameChar h t acc name rest
727+ ) =>
728+ CollectParamName input acc name rest
729+
730+class CollectParamNameChar :: Symbol -> Symbol -> Symbol -> Symbol -> Symbol -> Constraint
731+class CollectParamNameChar char tail acc name rest | char tail acc -> name rest
732+
733+instance
734+ ( Symbol.Cons " " tail rest
735+ ) =>
736+ CollectParamNameChar " " tail acc acc rest
737+
738+else instance
739+ ( Symbol.Cons ")" tail rest
740+ ) =>
741+ CollectParamNameChar ")" tail acc acc rest
742+
743+else instance
744+ ( Symbol.Cons "," tail rest
745+ ) =>
746+ CollectParamNameChar "," tail acc acc rest
747+
748+else instance
749+ ( Symbol.Append acc char acc'
750+ , CollectParamName tail acc' name rest
751+ ) =>
752+ CollectParamNameChar char tail acc name rest
753+
754+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
755+-- EndOrContinue: handle end-of-string or continue parsing
756+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
757+
758+class EndOrContinue :: Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
759+class EndOrContinue rest tables paramsIn paramsOut | rest tables paramsIn -> paramsOut
760+
761+instance EndOrContinue "" tables paramsIn paramsIn
762+else instance
763+ ( Symbol.Cons h t rest
764+ , ParseWhereGo h t tables paramsIn paramsOut
765+ ) =>
766+ EndOrContinue rest tables paramsIn paramsOut
767+
768+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
769+-- ResolveParamType: look up a param name in table columns
770+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
771+
772+class ResolveParamType :: Symbol -> RL.RowList Type -> Type -> Constraint
773+class ResolveParamType name rl typ | name rl -> typ
774+
775+instance (ExtractType entry typ) => ResolveParamType name (RL.Cons name entry tail) typ
776+else instance ResolveParamType name tail typ => ResolveParamType name (RL.Cons other entry tail) typ
777+
778+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
779+-- Builder: where_
780+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
781+
782+where_
783+ :: forall @whr tables result params p stage stage'
784+ . IsSymbol whr
785+ => ParseWhere whr tables params
786+ => HasAnyDML stage
787+ => Row.Lacks "where" stage
788+ => Row.Lacks "insert" stage
789+ => Row.Lacks "orderBy" stage
790+ => Row.Lacks "limit" stage
791+ => Row.Cons "where" Unit stage stage'
792+ => Q tables result p stage
793+ -> Q tables result params stage'
794+where_ (Q q) = Q (q { sql = q.sql <> " WHERE " <> reflectSymbol (Proxy :: Proxy whr) })
795+
796+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
797+-- Builder: orderBy
798+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
799+
800+orderBy
801+ :: forall @cols tables result params stage stage'
802+ . IsSymbol cols
803+ => HasClause "select" stage
804+ => Row.Lacks "orderBy" stage
805+ => Row.Lacks "limit" stage
806+ => Row.Cons "orderBy" Unit stage stage'
807+ => Q tables result params stage
808+ -> Q tables result params stage'
809+orderBy (Q q) = Q (q { sql = q.sql <> " ORDER BY " <> reflectSymbol (Proxy :: Proxy cols) })
810+
811+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
812+-- ParseLimitOffset: accept numeric literal or $paramName
813+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
814+
815+class ParseLimitOffset :: Symbol -> Row Type -> Row Type -> Constraint
816+class ParseLimitOffset sym paramsIn paramsOut | sym paramsIn -> paramsOut
817+
818+instance
819+ ( Symbol.Cons h t sym
820+ , ParseLimitOffsetChar h t paramsIn paramsOut
821+ ) =>
822+ ParseLimitOffset sym paramsIn paramsOut
823+
824+class ParseLimitOffsetChar :: Symbol -> Symbol -> Row Type -> Row Type -> Constraint
825+class ParseLimitOffsetChar head tail paramsIn paramsOut | head tail paramsIn -> paramsOut
826+
827+instance
828+ ( Symbol.Append "" tail paramName
829+ , Row.Cons paramName Int paramsIn paramsOut
830+ ) =>
831+ ParseLimitOffsetChar "$" tail paramsIn paramsOut
832+
833+else instance ParseLimitOffsetChar h tail paramsIn paramsIn
834+
835+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
836+-- Builder: limit
837+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
838+
839+limit
840+ :: forall @sym tables result params params' stage stage'
841+ . ParseLimitOffset sym params params'
842+ => IsSymbol sym
843+ => HasClause "select" stage
844+ => Row.Lacks "limit" stage
845+ => Row.Cons "limit" Unit stage stage'
846+ => Q tables result params stage
847+ -> Q tables result params' stage'
848+limit (Q q) = Q (q { sql = q.sql <> " LIMIT " <> reflectSymbol (Proxy :: Proxy sym) })
849+
850+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
851+-- CQL-specific: ifNotExists (after INSERT)
852+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
853+
854+ifNotExists
855+ :: forall tables result params stage stage'
856+ . HasClause "insert" stage
857+ => Row.Lacks "ifNotExists" stage
858+ => Row.Cons "ifNotExists" Unit stage stage'
859+ => Q tables result params stage
860+ -> Q tables result params stage'
861+ifNotExists (Q q) = Q (q { sql = q.sql <> " IF NOT EXISTS" })
862+
863+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
864+-- CQL-specific: ifExists (after UPDATE/DELETE WHERE)
865+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
866+
867+ifExists
868+ :: forall tables result params stage stage'
869+ . HasClause "where" stage
870+ => Row.Lacks "ifExists" stage
871+ => Row.Cons "ifExists" Unit stage stage'
872+ => Q tables result params stage
873+ -> Q tables result params stage'
874+ifExists (Q q) = Q (q { sql = q.sql <> " IF EXISTS" })
875+
876+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
877+-- CQL-specific: usingTTL (after INSERT)
878+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
879+
880+usingTTL
881+ :: forall @ttl tables result params stage stage'
882+ . IsSymbol ttl
883+ => HasClause "insert" stage
884+ => Row.Lacks "usingTTL" stage
885+ => Row.Cons "usingTTL" Unit stage stage'
886+ => Q tables result params stage
887+ -> Q tables result params stage'
888+usingTTL (Q q) = Q (q { sql = q.sql <> " USING TTL " <> reflectSymbol (Proxy :: Proxy ttl) })
889+
890+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
891+-- CQL-specific: withTTL (before set, produces UPDATE t USING TTL n)
892+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
893+
894+withTTL
895+ :: forall @ttl tables result params stage stage'
896+ . IsSymbol ttl
897+ => Row.Lacks "set" stage
898+ => Row.Lacks "select" stage
899+ => Row.Lacks "insert" stage
900+ => Row.Lacks "delete" stage
901+ => Row.Lacks "withTTL" stage
902+ => Row.Cons "withTTL" Unit stage stage'
903+ => Q tables result params stage
904+ -> Q tables result params stage'
905+withTTL (Q q) = Q (q { sql = q.sql <> " USING TTL " <> reflectSymbol (Proxy :: Proxy ttl) })
906+
907+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
908+-- CQL-specific: allowFiltering (after SELECT WHERE)
909+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
910+
911+allowFiltering
912+ :: forall tables result params stage stage'
913+ . HasClause "select" stage
914+ => Row.Lacks "allowFiltering" stage
915+ => Row.Cons "allowFiltering" Unit stage stage'
916+ => Q tables result params stage
917+ -> Q tables result params stage'
918+allowFiltering (Q q) = Q (q { sql = q.sql <> " ALLOW FILTERING" })
919+
920+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
921+-- ParseSelect: parse "col1, col2" into a result row
922+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
923+
924+class ParseSelect :: Symbol -> Row (Row Type) -> Row Type -> Constraint
925+class ParseSelect sym tables result | sym tables -> result
926+
927+instance ParseSelect "" tables ()
928+else instance
929+ ( Symbol.Cons h t sym
930+ , ParseSelectGo h t "" tables RL.Nil outRL
931+ , ListToRow outRL result
932+ ) =>
933+ ParseSelect sym tables result
934+
935+class ParseSelectGo :: Symbol -> Symbol -> Symbol -> Row (Row Type) -> RL.RowList Type -> RL.RowList Type -> Constraint
936+class ParseSelectGo head tail acc tables resultIn resultOut | head tail acc tables resultIn -> resultOut
937+
938+-- Comma with accumulated column name: flush column and continue
939+instance
940+ ( SingleTable tables tableName cols
941+ , RowToList cols colsRL
942+ , ResolveParamType acc colsRL typ
943+ , Symbol.Cons h2 t2 rest
944+ , SkipSpaces h2 t2 h3 t3
945+ , ParseSelectGo h3 t3 "" tables (RL.Cons acc typ resultIn) resultOut
946+ ) =>
947+ ParseSelectGo "," rest acc tables resultIn resultOut
948+
949+-- Space: skip and continue accumulating
950+else instance
951+ ( Symbol.Cons h2 t2 rest
952+ , ParseSelectGo h2 t2 acc tables resultIn resultOut
953+ ) =>
954+ ParseSelectGo " " rest acc tables resultIn resultOut
955+
956+-- End of string: flush final column
957+else instance
958+ ( Symbol.Append acc h acc'
959+ , SingleTable tables tableName cols
960+ , RowToList cols colsRL
961+ , ResolveParamType acc' colsRL typ
962+ ) =>
963+ ParseSelectGo h "" acc tables resultIn (RL.Cons acc' typ resultIn)
964+
965+-- Regular character with more input: accumulate
966+else instance
967+ ( Symbol.Append acc h acc'
968+ , Symbol.Cons h2 t2 rest
969+ , ParseSelectGo h2 t2 acc' tables resultIn resultOut
970+ ) =>
971+ ParseSelectGo h rest acc tables resultIn resultOut
972+
973+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
974+-- SkipSpaces: skip leading spaces
975+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
976+
977+class SkipSpaces :: Symbol -> Symbol -> Symbol -> Symbol -> Constraint
978+class SkipSpaces head tail outHead outTail | head tail -> outHead outTail
979+
980+instance (Symbol.Cons h2 t2 rest, SkipSpaces h2 t2 outHead outTail) => SkipSpaces " " rest outHead outTail
981+else instance SkipSpaces h t h t
982+
983+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
984+-- Builder: select @"col1, col2"
985+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
986+
987+select
988+ :: forall @sel tables result r p stage stage'
989+ . IsSymbol sel
990+ => ParseSelect sel tables result
991+ => Row.Lacks "select" stage
992+ => Row.Lacks "insert" stage
993+ => Row.Lacks "set" stage
994+ => Row.Lacks "delete" stage
995+ => Row.Lacks "where" stage
996+ => Row.Lacks "orderBy" stage
997+ => Row.Lacks "limit" stage
998+ => Row.Cons "select" Unit stage stage'
999+ => Q tables r p stage
1000+ -> Q tables result p stage'
1001+select (Q q) = Q (q { sql = "SELECT " <> reflectSymbol (Proxy :: Proxy sel) <> " FROM " <> q.sql })
1002+
1003+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1004+-- ParamsToArray: convert params record to Array { name, value }
1005+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1006+
1007+class ParamsToArray :: RL.RowList Type -> Row Type -> Constraint
1008+class ParamsToArray rl row where
1009+ paramsToArray :: Proxy rl -> { | row } -> Array { name :: String, value :: Foreign }
1010+
1011+instance ParamsToArray RL.Nil row where
1012+ paramsToArray _ _ = []
1013+
1014+instance
1015+ ( IsSymbol name
1016+ , Row.Cons name typ rest row
1017+ , Row.Lacks name rest
1018+ , ParamsToArray tail row
1019+ ) =>
1020+ ParamsToArray (RL.Cons name typ tail) row where
1021+ paramsToArray _ rec =
1022+ [ { name: reflectSymbol (Proxy :: Proxy name)
1023+ , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
1024+ }
1025+ ]
1026+ <> paramsToArray (Proxy :: Proxy tail) rec
1027+
1028+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1029+-- replaceNamedParams: replace $name with ? and build values array
1030+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1031+
1032+namedParamRegex :: Regex.Regex
1033+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*" RegexFlags.global of
1034+ Right r -> r
1035+ Left _ -> unsafeCoerce unit
1036+
1037+replaceNamedParams :: Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array Foreign }
1038+replaceNamedParams entries sql = do
1039+ let replacements = entries # foldl (\m e -> Map.insert ("$" <> e.name) "?" m) Map.empty
1040+ let
1041+ sql' = Regex.replace' namedParamRegex
1042+ ( \match_ _ -> case Map.lookup match_ replacements of
1043+ Nothing -> match_
1044+ Just v -> v
1045+ )
1046+ sql
1047+ { sql: sql', values: map (\e -> e.value) entries }
1048+
1049+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1050+-- Query execution
1051+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1052+
1053+decodeRows :: forall a. ReadForeign a => Array Foreign -> Either String (Array a)
1054+decodeRows rows = case traverse (\r -> readImpl r # runExcept) rows of
1055+ Left errs -> Left (show errs)
1056+ Right a -> Right a
1057+
1058+runQuery
1059+ :: forall tables result params paramsRL stage
1060+ . RowToList params paramsRL
1061+ => ParamsToArray paramsRL params
1062+ => ReadForeign { | result }
1063+ => Scylla.Client
1064+ -> { | params }
1065+ -> Q tables result params stage
1066+ -> Aff (Array { | result })
1067+runQuery client params (Q q) = do
1068+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
1069+ let { sql, values } = replaceNamedParams entries q.sql
1070+ let allValues = q.values <> values
1071+ result <- Scylla.execute (Scylla.CQL sql) allValues client
1072+ case decodeRows result.rows of
1073+ Left errs -> throwError (Exception.error ("Row decode failed: " <> errs))
1074+ Right rows -> pure rows
1075+
1076+runQueryOne
1077+ :: forall tables result params paramsRL stage
1078+ . RowToList params paramsRL
1079+ => ParamsToArray paramsRL params
1080+ => ReadForeign { | result }
1081+ => Scylla.Client
1082+ -> { | params }
1083+ -> Q tables result params stage
1084+ -> Aff (Maybe { | result })
1085+runQueryOne client params q = do
1086+ rows <- runQuery client params q
1087+ pure case rows of
1088+ [ x ] -> Just x
1089+ _ -> Nothing
1090+
1091+runExecute
1092+ :: forall tables params paramsRL stage
1093+ . RowToList params paramsRL
1094+ => ParamsToArray paramsRL params
1095+ => Scylla.Client
1096+ -> { | params }
1097+ -> Q tables () params stage
1098+ -> Aff Unit
1099+runExecute client params (Q q) = do
1100+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
1101+ let { sql, values } = replaceNamedParams entries q.sql
1102+ let allValues = q.values <> values
1103+ void $ Scylla.execute (Scylla.CQL sql) allValues client