@@ -2,18 +2,30 @@ module Yoga.Postgres.Schema where
22
33import Prelude
44
5−import Data.Array (intercalate, mapWithIndex)
6−import Data.Maybe (Maybe)
5+import Data.Array (intercalate, mapWithIndex, foldl)
6+import Data.Maybe (Maybe(..))
7+import Unsafe.Coerce (unsafeCoerce)
78import Data.Reflectable (class Reflectable, reflectType)
9+import Data.String.Regex (regex, replace') as Regex
10+import Data.String.Regex (Regex) as Regex
11+import Data.String.Regex.Flags (global) as Regex
12+import Control.Monad.Except (runExcept)
13+import Data.Either (Either(..))
14+import Data.Map as Map
815import Data.Symbol (class IsSymbol, reflectSymbol)
916import Data.Tuple.Nested (type (/\))
10−import Prim.Row (class Cons) as Row
17+import Effect.Aff (Aff)
18+import Foreign (Foreign, unsafeToForeign)
19+import Prim.Row (class Cons, class Lacks) as Row
1120import Prim.RowList as RL
1221import Prim.RowList (class RowToList)
1322import Prim.Symbol (class Cons, class Append) as Symbol
1423import Prim.TypeError (class Fail, Beside, Text, Quote)
24+import Record (get) as Record
1525import Type.Proxy (Proxy(..))
1626import Type.RowList (class ListToRow)
27+import Yoga.JSON (class ReadForeign, readImpl)
28+import Yoga.Postgres as PG
1729
1830-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
1931-- Core phantom types
@@ -907,3 +919,84 @@ where_ (Q base) = Q (base <> " WHERE " <> reflectSymbol (Proxy :: Proxy whr))
907919
908920toSQL :: forall name cols result params. Q name cols result params -> String
909921toSQL (Q s) = s
922+
923+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
924+-- Query execution
925+-- ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━
926+
927+class ParamsToArray :: RL.RowList Type -> Row Type -> Constraint
928+class ParamsToArray rl row where
929+ paramsToArray :: Proxy rl -> { | row } -> Array { name :: String, value :: Foreign }
930+
931+instance ParamsToArray RL.Nil row where
932+ paramsToArray _ _ = []
933+
934+instance
935+ ( IsSymbol name
936+ , Row.Cons name typ rest row
937+ , Row.Lacks name rest
938+ , ParamsToArray tail row
939+ ) =>
940+ ParamsToArray (RL.Cons name typ tail) row where
941+ paramsToArray _ rec =
942+ [ { name: reflectSymbol (Proxy :: Proxy name)
943+ , value: unsafeToForeign (Record.get (Proxy :: Proxy name) rec)
944+ }
945+ ]
946+ <> paramsToArray (Proxy :: Proxy tail) rec
947+
948+namedParamRegex :: Regex.Regex
949+namedParamRegex = case Regex.regex "\\$[a-zA-Z_][a-zA-Z0-9_]*" Regex.global of
950+ Right r -> r
951+ Left _ -> unsafeCoerce unit
952+
953+replaceNamedParams :: Array { name :: String, value :: Foreign } -> String -> { sql :: String, values :: Array PG.PGValue }
954+replaceNamedParams entries sql = do
955+ let indexed = entries # mapWithIndex \i e -> { idx: i + 1, name: e.name, value: e.value }
956+ let replacements = indexed # foldl (\m e -> Map.insert ("$" <> e.name) ("$" <> show e.idx) m) Map.empty
957+ let
958+ sql' = Regex.replace' namedParamRegex
959+ ( \match _ -> case Map.lookup match replacements of
960+ Nothing -> match
961+ Just v -> v
962+ )
963+ sql
964+ { sql: sql', values: map (\e -> unsafeCoerce e.value) indexed }
965+
966+runQuery
967+ :: forall name cols result params paramsRL
968+ . RowToList params paramsRL
969+ => ParamsToArray paramsRL params
970+ => ReadForeign { | result }
971+ => Q name cols result params
972+ -> { | params }
973+ -> PG.Connection
974+ -> Aff (Array { | result })
975+runQuery (Q sql) params conn = do
976+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
977+ let { sql: sql', values } = replaceNamedParams entries sql
978+ result <- PG.query (PG.SQL sql') values conn
979+ pure (unsafeDecodeRows result.rows)
980+
981+runQueryOne
982+ :: forall name cols result params paramsRL
983+ . RowToList params paramsRL
984+ => ParamsToArray paramsRL params
985+ => ReadForeign { | result }
986+ => Q name cols result params
987+ -> { | params }
988+ -> PG.Connection
989+ -> Aff (Maybe { | result })
990+runQueryOne (Q sql) params conn = do
991+ let entries = paramsToArray (Proxy :: Proxy paramsRL) params
992+ let { sql: sql', values } = replaceNamedParams entries sql
993+ result <- PG.queryOne (PG.SQL sql') values conn
994+ pure (result <#> unsafeDecodeRow)
995+
996+unsafeDecodeRows :: forall a. ReadForeign a => Array Foreign -> Array a
997+unsafeDecodeRows = map unsafeDecodeRow
998+
999+unsafeDecodeRow :: forall a. ReadForeign a => Foreign -> a
1000+unsafeDecodeRow f = case runExcept (readImpl f) of
1001+ Left _ -> unsafeCoerce unit
1002+ Right a -> a