generated from tpl/purs
feat: query builder can reference tables
This commit is contained in:
parent
825eaa0079
commit
2eba8bd07f
@ -15,6 +15,7 @@ package:
|
|||||||
- maybe
|
- maybe
|
||||||
- mmorph
|
- mmorph
|
||||||
- newtype
|
- newtype
|
||||||
|
- ordered-collections
|
||||||
- parallel
|
- parallel
|
||||||
- postgresql-client
|
- postgresql-client
|
||||||
- prelude
|
- prelude
|
||||||
|
@ -11,7 +11,7 @@ import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, ask)
|
|||||||
import Control.Monad.Rec.Class (class MonadRec)
|
import Control.Monad.Rec.Class (class MonadRec)
|
||||||
import Control.Monad.State (StateT(..))
|
import Control.Monad.State (StateT(..))
|
||||||
import Control.Monad.Trans.Class (class MonadTrans, lift)
|
import Control.Monad.Trans.Class (class MonadTrans, lift)
|
||||||
import Control.Monad.Writer (class MonadTell, class MonadWriter, WriterT(..))
|
import Control.Monad.Writer (class MonadTell, class MonadWriter)
|
||||||
import Control.MonadPlus (class MonadPlus)
|
import Control.MonadPlus (class MonadPlus)
|
||||||
import Control.Parallel (class Parallel, parallel, sequential)
|
import Control.Parallel (class Parallel, parallel, sequential)
|
||||||
import Data.Bifunctor (lmap)
|
import Data.Bifunctor (lmap)
|
||||||
@ -26,7 +26,6 @@ import Effect.Aff.Class (class MonadAff, liftAff)
|
|||||||
import Effect.Aff.Unlift (class MonadUnliftAff, UnliftAff(..), withUnliftAff)
|
import Effect.Aff.Unlift (class MonadUnliftAff, UnliftAff(..), withUnliftAff)
|
||||||
import Effect.Class (class MonadEffect)
|
import Effect.Class (class MonadEffect)
|
||||||
import Effect.Exception (Error, error)
|
import Effect.Exception (Error, error)
|
||||||
import Foreign (Foreign)
|
|
||||||
|
|
||||||
newtype HasPostgresT :: (Type -> Type) -> Type -> Type
|
newtype HasPostgresT :: (Type -> Type) -> Type -> Type
|
||||||
newtype HasPostgresT m a = HasPostgresT (ReaderT Pg.Connection m a)
|
newtype HasPostgresT m a = HasPostgresT (ReaderT Pg.Connection m a)
|
||||||
@ -154,13 +153,13 @@ class (Monad m, MonadThrow Error m) <= MonadPostgres m where
|
|||||||
instance (MonadUnliftAff m, MonadThrow Error m) => MonadPostgres (PostgresT m) where
|
instance (MonadUnliftAff m, MonadThrow Error m) => MonadPostgres (PostgresT m) where
|
||||||
query' nm q = do
|
query' nm q = do
|
||||||
conn <- ask
|
conn <- ask
|
||||||
qs /\ ps <- Query.runBuilder $ hoist nm q
|
qs /\ { params } <- Query.runBuilder $ hoist nm q
|
||||||
res <- liftAff $ Pg.Aff.query conn (Pg.Query qs) ps
|
res <- liftAff $ Pg.Aff.query conn (Pg.Query qs) params
|
||||||
liftEither $ lmap (error <<< show) $ res
|
liftEither $ lmap (error <<< show) $ res
|
||||||
exec' nm q = do
|
exec' nm q = do
|
||||||
conn <- ask
|
conn <- ask
|
||||||
qs /\ ps <- Query.runBuilder $ hoist nm q
|
qs /\ { params } <- Query.runBuilder $ hoist nm q
|
||||||
res <- liftAff $ Pg.Aff.execute conn (Pg.Query qs) ps
|
res <- liftAff $ Pg.Aff.execute conn (Pg.Query qs) params
|
||||||
liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
|
liftEither $ lmap (error <<< show) $ maybe (Right unit) Left $ res
|
||||||
transaction pg = do
|
transaction pg = do
|
||||||
conn :: Pg.Connection <- ask
|
conn :: Pg.Connection <- ask
|
||||||
|
@ -2,20 +2,24 @@ module Data.Postgres.Query.Builder where
|
|||||||
|
|
||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Control.Monad.State (StateT, get, put, runStateT)
|
import Control.Monad.State (StateT, modify, runStateT)
|
||||||
import Data.Array as Array
|
import Data.Array as Array
|
||||||
|
import Data.Set (Set)
|
||||||
|
import Data.Set as Set
|
||||||
import Data.Tuple.Nested (type (/\))
|
import Data.Tuple.Nested (type (/\))
|
||||||
import Database.PostgreSQL (class ToSQLValue, toSQLValue)
|
import Database.PostgreSQL (class ToSQLValue, toSQLValue)
|
||||||
import Foreign (Foreign)
|
import Foreign (Foreign)
|
||||||
|
|
||||||
type BuilderT m a = StateT (Array Foreign) m a
|
type BuilderT m a = StateT { params :: Array Foreign, refs :: Set String } m a
|
||||||
|
|
||||||
runBuilder :: forall m a. BuilderT m a -> m (a /\ Array Foreign)
|
runBuilder :: forall m a. BuilderT m a -> m (a /\ { params :: Array Foreign, refs :: Set String })
|
||||||
runBuilder = flip runStateT []
|
runBuilder = flip runStateT { params: [], refs: Set.empty }
|
||||||
|
|
||||||
|
reference :: forall m. Monad m => String -> BuilderT m Unit
|
||||||
|
reference k = void $ modify (\s@{ refs } -> s { refs = Set.insert k refs })
|
||||||
|
|
||||||
param :: forall m a. Monad m => ToSQLValue a => a -> BuilderT m String
|
param :: forall m a. Monad m => ToSQLValue a => a -> BuilderT m String
|
||||||
param p =
|
param p =
|
||||||
do
|
do
|
||||||
ps <- get
|
{ params } <- modify (\s@{ params } -> s { params = params <> [ toSQLValue p ] })
|
||||||
put $ ps <> [ toSQLValue p ]
|
pure $ "$" <> show (Array.length params)
|
||||||
pure $ "$" <> show (Array.length ps + 1)
|
|
||||||
|
@ -3,7 +3,8 @@ module Spec.Data.Postgres.Query.Builder where
|
|||||||
import Prelude
|
import Prelude
|
||||||
|
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Data.Postgres.Query.Builder (param, runBuilder)
|
import Data.Postgres.Query.Builder (param, reference, runBuilder)
|
||||||
|
import Data.Set as Set
|
||||||
import Data.Tuple.Nested ((/\))
|
import Data.Tuple.Nested ((/\))
|
||||||
import Foreign (unsafeFromForeign)
|
import Foreign (unsafeFromForeign)
|
||||||
import Foreign.Internal.Stringify (unsafeStringify)
|
import Foreign.Internal.Stringify (unsafeStringify)
|
||||||
@ -15,18 +16,34 @@ spec =
|
|||||||
describe "Data.Postgres.Query.Builder" do
|
describe "Data.Postgres.Query.Builder" do
|
||||||
describe "runBuilder" do
|
describe "runBuilder" do
|
||||||
it "empty" do
|
it "empty" do
|
||||||
_ /\ ps <- runBuilder (pure unit)
|
_ /\ { params, refs } <- runBuilder (pure unit)
|
||||||
map unsafeStringify ps `shouldEqual` []
|
map unsafeStringify params `shouldEqual` []
|
||||||
|
refs `shouldEqual` Set.empty
|
||||||
|
describe "reference" do
|
||||||
|
it "one" do
|
||||||
|
_ /\ { refs } <- runBuilder $ reference "foo"
|
||||||
|
refs `shouldEqual` (Set.singleton "foo")
|
||||||
|
it "dup" do
|
||||||
|
_ /\ { refs } <- runBuilder do
|
||||||
|
reference "foo"
|
||||||
|
reference "foo"
|
||||||
|
refs `shouldEqual` (Set.singleton "foo")
|
||||||
|
it "multiple" do
|
||||||
|
_ /\ { refs } <- runBuilder do
|
||||||
|
reference "foo"
|
||||||
|
reference "bar"
|
||||||
|
reference "baz"
|
||||||
|
refs `shouldEqual` (Set.fromFoldable [ "foo", "bar", "baz" ])
|
||||||
describe "param" do
|
describe "param" do
|
||||||
it "single" do
|
it "single" do
|
||||||
p /\ ps <- runBuilder $ param 123
|
p /\ { params } <- runBuilder $ param 123
|
||||||
p `shouldEqual` "$1"
|
p `shouldEqual` "$1"
|
||||||
map unsafeFromForeign ps `shouldEqual` [ 123 ]
|
map unsafeFromForeign params `shouldEqual` [ 123 ]
|
||||||
it "many" do
|
it "many" do
|
||||||
_ /\ ps <- runBuilder do
|
_ /\ { params } <- runBuilder do
|
||||||
a <- param 123
|
a <- param 123
|
||||||
b <- param "abc"
|
b <- param "abc"
|
||||||
c <- param [ 123 ]
|
c <- param [ 123 ]
|
||||||
d <- param true
|
d <- param true
|
||||||
lift $ [ a, b, c, d ] `shouldEqual` [ "$1", "$2", "$3", "$4" ]
|
lift $ [ a, b, c, d ] `shouldEqual` [ "$1", "$2", "$3", "$4" ]
|
||||||
map unsafeStringify ps `shouldEqual` [ "123", "\"abc\"", "[123]", "true" ]
|
map unsafeStringify params `shouldEqual` [ "123", "\"abc\"", "[123]", "true" ]
|
||||||
|
Loading…
Reference in New Issue
Block a user