initial commit

Author: zohl

LICENSE

@@ -0,0 +1,136 @@
+# Description
+  A FFI-like bindings for PostgreSQL strored functions.
+  
+  `postgresql-simple-bind` is an extension for `postgresql-simple`
+  library that faciliates and automates bindings creation. This is
+  especially useful in a design pattern where an application
+  communicates with a database via API hiding the internal structure
+  of the latter.
+
+# Example
+  Suppose we have the following functions in our database:
+
+  ```
+  function add_num(p_x bigint) returns void
+  function get_all_nums() returns setof bigint
+  ``` 
+
+  In order to use them in a haskell application we write the following code:
+
+  ```
+  import Database.PostgreSQL.Simple.Bind (bindFunction, defaultOptions)
+  import Database.PostgreSQL.Simple.Bind.Types()
+  
+  bindFunction defaultOptions "function add_num(p_x bigint) returns void"
+  bindFunction defaultOptions "function get_all_nums() returns setof bigint"
+  ```
+
+  That's it. Now we can stick them wherever we want to:
+  ```
+  add_many_nums :: Connection -> [Int] -> IO ()
+  add_many_nums conn xs = sequence_ $ map (add_num conn) xs
+  
+  get_sum :: Connection -> IO Int
+  get_sum conn = sum <$> (get_all_nums conn)
+  ```
+
+# Behind the scenes
+  It worth to mention that type translation from PostrgeSQL language to haskell
+  is two-step. Firstly, a PostgreSQL type mapped to `PostgresType` instance and
+  then this type family provides us the final type.
+  For example `add_num` is translated the following way:
+
+  ```
+  -- original PostgreSQL declaration
+  function add_num(p_x bigint) returns void
+  
+  -- first step
+  add_num :: ( PostgresType "bigint" ~ a, ToField a
+             , PostgresType "void" ~ b, FromField b) => Connection -> a -> IO b
+  
+  -- second step
+  add_num :: Connection -> Int -> IO ()
+  ```
+
+  where
+  ```
+  type instance PostgresType "bigint" = Int
+  type instance PostgresType "void"   = ()
+  ``` 
+  as they are defined in `Database.PostgreSQL.Simple.Bind.Types`.
+
+  What if the provided instances give us unwanted types (e.g. `varchar` is
+  mapped to `Text` while we want `String`)? This is why all the instances are
+  defined into a separated module. We just do not import the module and define
+  our own instances.
+
+
+# On types
+  As we mentioned in the previous section there are certain restrictions on the
+  types that can be used in `PostgresType` instances.
+
+  One of them comes naturally: all argument and result types must be instances of
+  `ToField` and `FromField` respectively.
+
+  In case there is an argument with a default value, it's corresponding type
+  will be wrapped into `Maybe` constructor.
+
+  Complex types cannot be specified unless there are corresponding `FromRow`
+  and/or `ToRow` instances. This means there is no support for `record` return
+  type as it doesn't disclose any information on it's structure.
+
+  Another caveat is about functions returning tables (or sets of composite
+  types). There is no way to put `not null` constraint on the resulting columns,
+  so such function can return result with `null` in any column. At the current
+  moment this behaviour is not supported, so each function returning table is
+  supposed to return non-`null`-values.
+
+
+# Customization
+  There are not so much ways to change behaviour of `bindFunction` (yet).
+  In the most cases the only required tweak is renaming stored functions.
+  This can be done by specifying `nameModifier` and `schemaModifier` options.
+  For example if database and application code adhere snake case and camel case
+  naming conventions respectively, conversion can be made like this:
+
+  ```
+  import Text.CaseConversion
+  import Database.PostgreSQL.Simple.Bind (Options(..), defaultOptions)
+  
+  bindOptions :: Options
+  bindOptions = defaultOptions {
+      nameModifier = convertCase Snake Camel
+    }
+  ```
+
+# Automated generation
+  It can be tedious to manually maintain consistent function declarations
+  across the codebase. More convenient way is to automatically generate module
+  during the compilation time. In case of cabal it can be done by using 
+  preBuild hook: set `build-type` to `Custom` in .cabal-file and define
+  `main` in Setup.hs like this
+
+  ```
+  import Database.PostgreSQL.Simple.Bind.Util (generateBindingsModule)
+   
+  main :: IO ()
+  main = defaultMainWithHooks $ simpleUserHooks { preBuild = mkBindings }
+  
+  mkBindings :: Args -> BuildFlags -> IO HookedBuildInfo
+  mkBindings args buildFlags = do
+    conn <- connect connectInfo
+    (generateBindingsModule conn
+       "Database.PostgreSQL.Simple.Bind.defaultOptions" "Bindings" [
+            "stored_function_1"
+          , "stored_function_2"
+          -- ...
+          ]) >>= (writeFile "./src/Bindings.hs")
+    close conn
+    return emptyHookedBuildInfo
+  ```
+
+  Every time the build procedure is executed, there will be database
+  lookup for function signatures.
+   
+  
+

README.md

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

Setup.hs

@@ -0,0 +1,18 @@
+{ mkDerivation, attoparsec, base, bytestring, case-conversion
+, heredoc, HUnit, postgresql-simple, stdenv, template-haskell, text
+, time
+}:
+mkDerivation {
+  pname = "postgresql-simple-bind";
+  version = "0.1.0.0";
+  src = ./.;
+  libraryHaskellDepends = [
+    attoparsec base bytestring heredoc postgresql-simple
+    template-haskell text time
+  ];
+  testHaskellDepends = [
+    base bytestring case-conversion HUnit postgresql-simple text
+  ];
+  description = "A FFI-like bindings to stored functions";
+  license = stdenv.lib.licenses.gpl3;
+}

default.nix

@@ -0,0 +1,34 @@
+module Common (
+    TestEnv(..)
+  , mkTest
+  , include
+  , bindOptions
+  ) where
+
+import Test.HUnit
+import Control.Exception.Base
+import Text.CaseConversion
+import Database.PostgreSQL.Simple
+import Database.PostgreSQL.Simple.Bind (Options(..), defaultOptions)
+import Database.PostgreSQL.Simple.Types
+import qualified Data.ByteString.Char8 as BS
+
+
+data TestEnv = TestEnv {
+    connectInfo :: ConnectInfo
+  }
+
+bindOptions :: Options
+bindOptions = defaultOptions {
+    nameModifier = convertCase Snake Camel . ("sql_" ++)
+  } 
+
+withConn :: ConnectInfo -> (Connection -> IO a) -> IO a
+withConn connectInfo = bracket (connect connectInfo) close
+  
+mkTest :: (Connection -> IO ()) -> (Connection -> IO()) -> TestEnv -> Test
+mkTest setup run env = TestCase $ withConn (connectInfo env)
+  (\conn -> mapM_ ($ conn) [begin, setup, run, rollback])
+
+include :: Connection -> String -> IO ()
+include conn fn = readFile fn >>= (execute_ conn . Query . BS.pack) >> return ()

examples/Common.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TypeFamilies      #-}
+
+-- 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 (
+    messages
+  ) where
+
+import Test.HUnit
+import Database.PostgreSQL.Simple.Bind (bindFunction)      
+import Database.PostgreSQL.Simple.Bind.Types()
+import Database.PostgreSQL.Simple (Connection)
+import Prelude hiding (getContents)
+import Common (bindOptions, TestEnv, mkTest, include)
+
+concat <$> mapM (bindFunction bindOptions) [
+    "function send_message(p_receiver varchar, p_contents varchar) 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"
+  ]
+
+
+runTests :: Int -> Connection -> IO ()
+runTests n conn = do
+  let getId (x, _, _) = x
+
+  msg1 <- sqlSendMessage conn "mr_foo" "hello!"
+  msg2 <- sqlSendMessage conn "mr_bar" "hello!"
+  msg3 <- sqlSendMessage conn "mr_bar" "hello again!"
+
+  sqlGetNewMessages conn "mr_foo" >>= \xs ->
+    assertEqual ("check get_new_messages " ++ (show n) ++ ".1") [msg1] (map getId xs)
+
+  sqlGetNewMessages conn "mr_bar" >>= \xs ->
+    assertEqual ("check get_new_messages " ++ (show n) ++ ".2") [msg2, msg3] (map getId xs)
+
+  sqlMarkAsRead conn "mr_bar" msg2
+
+  sqlGetNewMessages conn "mr_bar" >>= \xs ->
+    assertEqual ("check get_new_messages " ++ (show n) ++ ".3") [msg3] (map getId xs)
+
+  sqlMarkAsRead conn "mr_foo" msg1
+  sqlMarkAsRead conn "mr_bar" msg3
+
+
+messages :: TestEnv -> Test
+messages = mkTest (flip include "./examples/sql/messages.sql")
+  (\conn -> do
+     runTests 1 conn
+     include conn "./examples/sql/messages-patch-1.sql"
+     runTests 2 conn
+     include conn "./examples/sql/messages-patch-2.sql"
+     runTests 3 conn)
+

examples/ExMessages.hs

@@ -0,0 +1,70 @@
+{-# 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 (
+    numDumpster
+  ) where
+
+import Test.HUnit
+import Database.PostgreSQL.Simple
+
+import Database.PostgreSQL.Simple.Bind (bindFunction)      
+import Database.PostgreSQL.Simple.Bind.Types()
+
+import Common (bindOptions, TestEnv, mkTest, include)
+
+
+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 = sequence_ $ map (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'
+  
+
+numDumpster :: TestEnv -> Test
+numDumpster = mkTest (flip include "./examples/sql/numdumpster.sql")
+  (\conn -> do
+      sqlAddNum conn 1
+      sqlGetLastNum conn >>= \x -> assertEqual "check get_last_num" 1 x
+       
+      sqlClear conn
+      addManyNums conn [1, 2, 3, 4]
+      sqlGetAllNums conn >>= \xs -> assertEqual "check get_all_nums" [1, 2, 3, 4] xs
+
+      sqlGetRange conn Nothing Nothing   >>= \xs -> assertEqual "check get_range" [1, 2, 3, 4] xs
+      sqlGetRange conn (Just 2) (Just 3) >>= \xs -> assertEqual "check get_range" [2, 3] xs
+      sqlGetRange conn Nothing (Just 3)  >>= \xs -> assertEqual "check get_range" [1, 2, 3] xs
+      sqlGetRange conn (Just 2) Nothing  >>= \xs -> assertEqual "check get_range" [2, 3, 4] xs
+
+      sqlClear conn
+      addManyNums conn [0, 1]
+      ((head . reverse) <$> (sequence $ replicate 11 (iterFib conn))) >>=
+         \x -> assertEqual "check 11th fibonacci number" 144 x)
+