postgresql-simple-bind 0.4.0 → 0.4.1

raw patch · 11 files changed

+518/−3 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−2
• examples/Common.hs +43/−0
• examples/ExMessages.hs +63/−0
• examples/ExNumDumpster.hs +65/−0
• examples/ExUsers.hs +71/−0
• examples/sql/messages-patch-1.sql +17/−0
• examples/sql/messages-patch-2.sql +72/−0
• examples/sql/messages.sql +46/−0
• examples/sql/numdumpster.sql +64/−0
• examples/sql/users.sql +60/−0
• postgresql-simple-bind.cabal +8/−1

@@ -1,11 +1,16 @@ # Change Log -## [Unreleased]+## [HEAD] +## [0.4.1]+### Changed+- Fixed missing files.+ ## [0.4.0] ### Added - Changelog. - Explicit type casts options.+ ### Changed - Flags `older-call-syntax` and `debug-queries` are options now. @@ -21,6 +26,7 @@ ## [0.2.0] - 2016-08-21 ### Added - Cabal flag `dev`.+ ### Changed - Relicensed to `BSD3`. - Refactored tests (now using `hspec`).@@ -30,7 +36,8 @@ ### Added - Initial version of the package. -[Unreleased]: ../../compare/v0.4.0...HEAD+[HEAD]:  ../../compare/v0.4.1...HEAD+[0.4.1]: ../../compare/v0.4.0...v0.4.1 [0.4.0]: ../../compare/v0.3.0...v0.4.0 [0.3.0]: ../../compare/v0.2.1...v0.3.0 [0.2.1]: ../../compare/v0.2.0...v0.2.1

@@ -0,0 +1,43 @@+{-# LANGUAGE LambdaCase #-}++module Common (+    withDB+  , withRollback+  , include+  , bindOptions+  ) where++import Data.Default (def)+import Control.Exception.Base (bracket)+import Control.Monad (void)+import Database.PostgreSQL.Simple (Connection, ConnectInfo, connect, begin, rollback, close, execute_)+import Database.PostgreSQL.Simple.Bind (PostgresBindOptions(..), PGFunction(..), ReturnType(..))+import Database.PostgreSQL.Simple.Types (Query(..))+import Text.CaseConversion (convertCase, WordCase(..))+import qualified Data.ByteString.Char8 as BS++mkFunctionName :: PGFunction -> String+mkFunctionName = convertCase Snake Camel . ("sql_" ++) . pgfName++bindOptions :: PostgresBindOptions+bindOptions = (def :: PostgresBindOptions) {+    pboFunctionName    = mkFunctionName+  , pboSetOfReturnType = \case+      "t_user" -> AsRow+      _        -> AsField+  , pboIsNullable      = isNullable+  , pboDebugQueries    = True+  } where+    isNullable :: String -> String -> Bool+    isNullable "get_new_messages" "contents" = True+    isNullable _                  _          = False+++withDB :: ConnectInfo -> (Connection -> IO a) -> IO a+withDB connectInfo = bracket (connect connectInfo) close++withRollback :: (Connection -> IO ()) -> (Connection -> IO ())+withRollback action = \conn -> mapM_ ($ conn) [begin, action, rollback]++include :: Connection -> String -> IO ()+include conn fn = void $ BS.readFile fn >>= (execute_ conn . Query)

@@ -0,0 +1,63 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE DeriveGeneric     #-}++-- Legend:+--   API for reading and sending messages.+--   We apply database patches that modify internal structure yet do not+--   break the API.+--+-- This is a demonstration of the pattern where the database and the+-- application communicate via API. All three times we run the same test+-- against different editions of the database.+++module ExMessages (+    specMessages+  ) where++import Common (bindOptions, include)+import Database.PostgreSQL.Simple (Connection)+import Database.PostgreSQL.Simple.Bind (bindFunction)+import Database.PostgreSQL.Simple.Bind.Types()+import Prelude hiding (getContents)+import Test.Hspec (Spec, describe, it, shouldBe)++concat <$> mapM (bindFunction bindOptions) [+    "function send_message(p_receiver varchar, p_contents varchar default null) returns bigint"+  , "function get_new_messages(p_receiver varchar) returns table (message_id bigint, sender varchar, contents varchar)"+  , "function mark_as_read(p_receiver varchar, p_message_id bigint) returns void"+  ]+++specMessages :: Connection -> Spec+specMessages conn = describe "Messages example" $ it "works" $ mapM_ runTests [+    "./examples/sql/messages.sql"+  , "./examples/sql/messages-patch-1.sql"+  , "./examples/sql/messages-patch-2.sql"+  ] where++  getId (x, _, _) = x++  runTests fn = do+    include conn fn++    msg1 <- sqlSendMessage conn "mr_foo" (Just "hello!")+    msg2 <- sqlSendMessage conn "mr_bar" (Just "hello!")+    msg3 <- sqlSendMessage conn "mr_bar" (Just "hello again!")++    sqlGetNewMessages conn "mr_foo" >>= shouldBe [msg1] . map getId+    sqlGetNewMessages conn "mr_bar" >>= shouldBe [msg2, msg3] . map getId++    sqlMarkAsRead conn "mr_bar" msg2++    sqlGetNewMessages conn "mr_bar" >>= shouldBe [msg3] . map getId++    sqlMarkAsRead conn "mr_foo" msg1+    sqlMarkAsRead conn "mr_bar" msg3++    msg4 <- sqlSendMessage conn "mr_baz" Nothing+    sqlGetNewMessages conn "mr_baz" >>= shouldBe [(msg4, Nothing)] . map (\(a, _, b) -> (a, b))+    sqlMarkAsRead conn "mr_baz" msg4

@@ -0,0 +1,65 @@+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE ExistentialQuantification #-}++-- Legend:+--   NumDumpster is a collection of numbers stored in a database.+--   API provides some basic functions to manipulate the collection.+--+-- This is an example of using basic features of the library+++module ExNumDumpster (+    specNumDumpster+  ) where++import Common (bindOptions, include)+import Database.PostgreSQL.Simple (Connection)+import Database.PostgreSQL.Simple.Bind (bindFunction)+import Database.PostgreSQL.Simple.Bind.Types()+import Test.Hspec (Spec, describe, it, shouldBe)+++concat <$> mapM (bindFunction bindOptions) [+    "function add_num(p_x bigint) returns void"+  , "function get_last_num() returns bigint"+  , "function get_range(p_range_min bigint default null, p_range_max bigint default null) returns setof bigint"+  , "function get_all_nums() returns setof bigint"+  , "function clear() returns void"+  ]++addManyNums :: Connection -> [Int] -> IO ()+addManyNums conn xs = mapM_ (sqlAddNum conn) xs++getSum :: Connection -> IO Int+getSum conn = sum <$> (sqlGetAllNums conn)++iterFib :: Connection -> IO Int+iterFib conn = do+  x  <- sqlGetLastNum conn+  x' <- getSum conn+  sqlClear conn+  addManyNums conn [x, x']+  return x'++specNumDumpster :: Connection -> Spec+specNumDumpster conn = describe "NumDumpster example" $ it "works" $ do+  include conn "./examples/sql/numdumpster.sql"++  sqlAddNum conn 1+  sqlGetLastNum conn >>= shouldBe 1++  sqlClear conn+  addManyNums conn [1, 2, 3, 4]+  sqlGetAllNums conn >>= shouldBe [1, 2, 3, 4]++  sqlGetRange conn Nothing Nothing   >>= shouldBe [1, 2, 3, 4]+  sqlGetRange conn (Just 2) (Just 3) >>= shouldBe [2, 3]+  sqlGetRange conn Nothing (Just 3)  >>= shouldBe [1, 2, 3]+  sqlGetRange conn (Just 2) Nothing  >>= shouldBe [2, 3, 4]++  sqlClear conn+  addManyNums conn [0, 1]+  ((head . reverse) <$> (sequence $ replicate 11 (iterFib conn))) >>= shouldBe 144

@@ -0,0 +1,71 @@+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE MultiWayIf           #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE LambdaCase           #-}+{-# LANGUAGE DeriveGeneric        #-}++-- Legend:+--   A CRUD-like API for table of users.+--   Due to backward compatibility requirements some of legacy types must be+--   preserved.+--+-- This is an example of using custom types.+++module ExUsers (+    specUsers+  ) where++import Common (bindOptions, include)+import Data.Text (Text)+import Database.PostgreSQL.Simple (Connection)+import Database.PostgreSQL.Simple.FromRow (FromRow)+import Database.PostgreSQL.Simple.Bind (bindFunction, PostgresType)+import Database.PostgreSQL.Simple.Bind.Types()+import GHC.Generics (Generic)+import Test.Hspec (Spec, describe, it, shouldBe)++concat <$> mapM (bindFunction bindOptions) [+    "function get_users(p_filter varchar2 default '') returns setof t_user"+  , "function add_user(p_name varchar2, p_age bigint) returns bigint"+  , "function del_user(p_user_id bigint) returns void"+  ]++type instance PostgresType "varchar2" = Text+++data User = User {+    userId   :: Int+  , userName :: String+  , userAge  :: Int+  } deriving (Eq, Show, Generic)++instance FromRow User+type instance PostgresType "t_user" = User+++specUsers :: Connection -> Spec+specUsers conn = describe "Users example" $ it "works" $ do+  include conn "./examples/sql/users.sql"++  mrFooId <- sqlAddUser conn "Mr. Foo" 42+  mrBarId <- sqlAddUser conn "Mr. Bar" 53+  mrBazId <- sqlAddUser conn "Mr. Baz" 64++  sqlGetUsers conn (Just "Mr. Foo") >>= \[u] -> (u { userId = 1 }) `shouldBe` (User {+      userId   = 1+    , userName = "Mr. Foo"+    , userAge  = 42+    })++  sqlGetUsers conn Nothing >>= shouldBe [mrFooId, mrBarId, mrBazId] . map userId+  sqlGetUsers conn (Just "Mr. Ba_") >>= shouldBe [mrBarId, mrBazId] . map userId+  sqlDelUser conn mrBarId++  sqlGetUsers conn Nothing >>= shouldBe [mrFooId, mrBazId] . map userId+

@@ -0,0 +1,17 @@+alter table messages add column creation_time timestamp default current_timestamp;++create or replace function get_new_messages(p_receiver varchar) returns table (+  message_id  bigint+, sender      varchar+, contents    varchar+) as+$get_new_messages$+  select message_id, sender, contents+  from messages+  where receiver = p_receiver+    and is_read = false+  order by creation_time asc;+$get_new_messages$+language sql+security definer;+

@@ -0,0 +1,72 @@+create table accounts (+  account_id bigint   primary key+, name       varchar  not null+);++insert into accounts(account_id, name)+  select nextval('s_id') as account_id+       , t.name+  from (+    select distinct sender as name from messages+    union+    select distinct receiver as name from messages) t;+++alter table messages+  add column sender_id bigint+, add column receiver_id bigint;++update messages set+  sender_id = (select account_id from accounts a where name = sender)+, receiver_id = (select account_id from accounts a where name = receiver);++alter table messages+  add constraint msg_sender_id_fk foreign key (sender_id) references accounts(account_id)+, add constraint msg_receiver_id_fk foreign key (receiver_id) references accounts(account_id)+, drop column sender+, drop column receiver;+++create or replace function send_message(p_receiver varchar, p_contents varchar default null) returns bigint as+$send_message$+  insert into messages(message_id, sender_id, receiver_id, contents)+  values (+    nextval('s_id')+  , (select account_id from accounts where name = user)+  , (select account_id from accounts where name = p_receiver)+  , p_contents)+  returning message_id;+$send_message$+language sql+security definer;+++create or replace function get_new_messages(p_receiver varchar) returns table (+  message_id  bigint+, sender      varchar+, contents    varchar+) as+$get_new_messages$+  select message_id, acc_sender.name, contents+  from messages msg+     , accounts acc_sender+     , accounts acc_receiver+  where msg.sender_id = acc_sender.account_id+    and msg.receiver_id = acc_receiver.account_id+    and acc_receiver.name = p_receiver+    and msg.is_read = false+  order by creation_time;+$get_new_messages$+language sql+security definer;+++create or replace function mark_as_read(p_receiver varchar, p_message_id bigint) returns void as+$mark_as_read$+  update messages set is_read = true+  where receiver_id in (select account_id from accounts where name = p_receiver)+    and message_id = p_message_id;+$mark_as_read$+language sql+security definer;+

@@ -0,0 +1,46 @@+create sequence s_id;++create table messages (+  message_id   bigint   primary key+, sender       varchar  not null+, receiver     varchar  not null+, contents     varchar+, is_read      boolean  default false+);++create function send_message(p_receiver varchar, p_contents varchar default null) returns bigint as+$send_message$+  insert into messages(message_id, sender, receiver, contents)+  values (+    nextval('s_id')+  , current_user+  , p_receiver+  , p_contents)+  returning message_id;+$send_message$+language sql+security definer;++create function get_new_messages(p_receiver varchar) returns table (+  message_id  bigint+, sender      varchar+, contents    varchar+) as+$get_new_messages$+  select message_id, sender, contents+  from messages+  where receiver = p_receiver+    and is_read = false;+$get_new_messages$+language sql+security definer;++create function mark_as_read(p_receiver varchar, p_message_id bigint) returns void as+$mark_as_read$+  update messages set is_read = true+  where receiver = p_receiver+    and message_id = p_message_id;+$mark_as_read$+language sql+security definer;+

@@ -0,0 +1,64 @@+create table numdumpster (+  id  bigint primary key+, x   bigint+);++create function get_last_num() returns bigint as+$get_last_num$+  select x+  from numdumpster nd+  order by nd.id desc+  limit 1;+$get_last_num$+language sql+security definer;+++create function get_all_nums() returns setof bigint as+$get_all_nums$+  select x+  from numdumpster nd+  order by nd.id asc;+$get_all_nums$+language sql+security definer;+++create function get_range(+    p_range_min bigint default null+  , p_range_max bigint default null+) returns setof bigint as+$get_all_nums$+  select x+  from numdumpster nd+  where x >= coalesce(p_range_min, x)+    and x <= coalesce(p_range_max, x)+  order by nd.id asc;+$get_all_nums$+language sql+security definer;+++create function add_num(p_x bigint) returns void as+$add_num$+  insert into numdumpster(id, x)+    select coalesce(max(nd.id), 0) + 1, p_x from numdumpster nd;+$add_num$+language sql+security definer;+++create function clear() returns void as+$clear$+  delete from numdumpster;+$clear$+language sql+security definer;++create function get_val(p_number bigint default '14') returns bigint as+$$+  select p_number;+$$+language sql;++

@@ -0,0 +1,60 @@+create domain varchar2 as varchar+  default ''+  not null+  check (length(value) <= 4000);+++create function nvl(p varchar2, alt varchar2) returns varchar2 as+$nvl$+  select (case p when '' then alt else p end);+$nvl$+language sql;+++create table users (+  user_id     bigint    primary key+, name        varchar2  not null+, age         bigint    not null+, is_active   boolean   not null default true);+++create type t_user as (+  user_id  bigint+, name     varchar2+, age      bigint);+++create function get_users(p_filter varchar2 default '') returns setof t_user as+$get_users_1$+  select user_id, name, age+  from users+  where is_active = true+    and name like nvl(p_filter, name)+  order by user_id;+$get_users_1$+language sql+security definer;+++create function add_user(p_name varchar2, p_age bigint) returns bigint as+$add_user$+  insert into users(user_id, name, age)+  values (+    (select coalesce(max(user_id), 0) + 1 from users)+  , p_name+  , p_age)+  returning user_id;+$add_user$+language sql+security definer;+++create function del_user(p_user_id bigint) returns void as+$del_user$+  update users+  set is_active = false+  where user_id = p_user_id;+$del_user$+language sql+security definer;+

@@ -1,5 +1,5 @@ name:                postgresql-simple-bind-version:             0.4.0+version:             0.4.1 synopsis:            FFI-like bindings for PostgreSQL stored functions description:         For tutorial see here: https:\/\/github.com\/zohl\/postgresql-simple-bind\/blob\/master\/README.md license:             BSD3@@ -13,6 +13,7 @@  extra-source-files:   CHANGELOG.md+  examples/sql/*.sql  flag dev   description: Turn on development settings.@@ -86,6 +87,12 @@    hs-source-dirs:   examples   main-is:          Main.hs+  other-modules:+    Common+    ExMessages+    ExNumDumpster+    ExUsers+   default-language: Haskell2010    ghc-options: -Wall -Wno-redundant-constraints