hasql-effectful (empty) → 0.1.0.0

raw patch · 6 files changed

+240/−0 lines, 6 filesdep +basedep +bytestringdep +effectful

Dependencies added: base, bytestring, effectful, hasql, hasql-effectful, hasql-pool, hasql-transaction, text

Files

CHANGELOG.md +5/−0
LICENSE +20/−0
examples/Main.hs +108/−0
hasql-effectful.cabal +62/−0
src/Effectful/Hasql.hs +41/−0
test/Main.hs +4/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for hasql-effectful++## 0.1.0.0 -- 2023-12-27++* Initial release

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2023 Nadeem Bitar++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ examples/Main.hs view

@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.ByteString.Char8 (pack)+import Data.Functor.Contravariant ((>$<))+import Data.Int (Int32)+import Data.Text (Text)+import Effectful+import Effectful.Error.Static+import Effectful.Hasql+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Pool (Pool, UsageError, acquire)+import Hasql.Session (Session, statement)+import Hasql.Statement (Statement (..))+import Hasql.Transaction qualified as T+import Hasql.Transaction.Sessions+import System.Environment (lookupEnv)++data User = User+  { firstName :: Text,+    lastName :: Text,+    userId :: Maybe Int32+  }+  deriving stock (Show)++userDecoder :: D.Row User+userDecoder =+  User+    <$> D.column (D.nonNullable D.text)+    <*> D.column (D.nonNullable D.text)+    <*> D.column (D.nullable D.int4)++userEncoder :: E.Params User+userEncoder =+  (firstName >$< E.param (E.nonNullable E.text))+    <> (lastName >$< E.param (E.nonNullable E.text))++insertUser_ :: Statement User Int32+insertUser_ =+  Statement sql encoder decoder True+  where+    sql = "INSERT INTO users (first_name, last_name) VALUES ($1, $2) RETURNING id"+    encoder = userEncoder+    decoder = D.singleRow ((D.column . D.nonNullable) D.int4)++findUserById_ :: Statement Int32 (Maybe User)+findUserById_ =+  Statement sql encoder decoder True+  where+    sql = "SELECT first_name, last_name, id FROM users WHERE id = $1"+    encoder = E.param $ E.nonNullable E.int4+    decoder = D.rowMaybe userDecoder++findUserById :: Int32 -> Session (Maybe User)+findUserById userId = statement userId findUserById_++insertUser :: User -> Session Int32+insertUser user = transaction Serializable Write $ do+  T.statement user insertUser_++createUser :: (Hasql :> es, Error UsageError :> es) => User -> Eff es Int32+createUser user = do+  runSession $ insertUser user++findUser :: (Hasql :> es, Error UsageError :> es) => Int32 -> Eff es (Maybe User)+findUser userId = do+  runSession $ findUserById userId++mkPool :: IO Pool+mkPool = do+  pgHost <- lookupEnv "PG_CONNECTION_STRING"+  case pgHost of+    Just h -> acquire 3 10 1_800 1_800 (pack h)+    Nothing -> error "PG_CONNECTION_STRING env is not defined or is invalid"++createTableStatement :: Statement () ()+createTableStatement = Statement sql mempty D.noResult False+  where+    sql = "CREATE TABLE IF NOT EXISTS users (id SERIAL PRIMARY KEY, first_name TEXT, last_name TEXT)"++createTable :: (Hasql :> es, Error UsageError :> es) => Eff es ()+createTable = do+  runSession $ statement () createTableStatement++newUser :: User+newUser = User "Sung-kyung" "Lee" Nothing++sampleApp :: (Hasql :> es, Error UsageError :> es) => Eff es (Maybe User)+sampleApp = do+  uId <- createUser newUser+  findUser uId++runToIO :: Pool -> Eff [Hasql, Error UsageError, IOE] a -> IO a+runToIO pool = runEff . runErrorWith @UsageError handleUsageError . runHasqlIO pool++handleUsageError :: (IOE :> es) => CallStack -> UsageError -> Eff es a+handleUsageError callStack err = do+  liftIO $ putStrLn $ "Usage error" <> show err <> prettyCallStack callStack+  error "hasql usage error"++main :: IO ()+main = do+  pool <- mkPool+  _ <- runToIO pool createTable+  u <- runToIO pool sampleApp+  print u

+ hasql-effectful.cabal view

@@ -0,0 +1,62 @@+cabal-version:   3.4+name:            hasql-effectful+version:         0.1.0.0+synopsis:        Effectful bindings for hasql+description:+  @<https://hackage.haskell.org/package/effectful Effectful>@ bindings for @<https://hackage.haskell.org/package/hasql hasql>@++category:        Database+homepage:        https://github.com/shinzui/hasql-effectful+license:         MIT+license-file:    LICENSE+author:          Nadeem Bitar+maintainer:      nadeem@gmail.com+build-type:      Simple+extra-doc-files: CHANGELOG.md++common common+  ghc-options:        -Wall+  default-extensions:+    DataKinds+    DerivingStrategies+    LambdaCase+    TypeFamilies++library+  import:           common+  exposed-modules:  Effectful.Hasql+  build-depends:+    , base        ^>=4.17   && <5+    , effectful   >=1.3.0.0 && <3.0.0.0+    , hasql       ^>=1.6    && <2+    , hasql-pool  ^>=0.10++  hs-source-dirs:   src+  default-language: GHC2021++executable hasql-effectful-example+  import:           common+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N+  main-is:          Main.hs+  build-depends:+    , base               ^>=4.17+    , bytestring         ^>=0.11.5+    , effectful          ^>=2.3.0+    , hasql              ^>=1.6+    , hasql-effectful+    , hasql-pool         ^>=0.10.0+    , hasql-transaction  ^>=1.0.1+    , text               ^>=2.0++  hs-source-dirs:   examples+  default-language: GHC2021++test-suite hasql-effectful-test+  import:           common+  default-language: GHC2021+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Main.hs+  build-depends:+    , base             ^>=4.17+    , hasql-effectful

+ src/Effectful/Hasql.hs view

@@ -0,0 +1,41 @@+module Effectful.Hasql+  ( -- * Effect+    Hasql (..),+    runSession,++    -- * Handlers+    runHasqlIO,+    runWithPool,+  )+where++import Effectful+import Effectful.Dispatch.Dynamic+import Effectful.Error.Static+import Hasql.Pool (Pool, UsageError, use)+import Hasql.Session (Session)++-- | Provides the ability to execute actions against a postgresql database+data Hasql :: Effect where+  RunSession :: Error UsageError :> es => Session a -> Hasql (Eff es) a++type instance DispatchOf Hasql = Dynamic++runSession :: (HasCallStack, Error UsageError :> es, Hasql :> es) => Session a -> Eff es a+runSession = send . RunSession++runHasqlIO ::+  forall es a.+  ( IOE :> es+  ) =>+  Pool ->+  Eff (Hasql : es) a ->+  Eff es a+runHasqlIO pool = interpret $ \env -> \case+  RunSession session -> do+    r <- liftIO $ use pool session+    localSeqUnlift env $ \unlift -> unlift $ do+      either throwError pure r++runWithPool :: Pool -> Eff [Hasql, Error UsageError, IOE] a -> IO (Either (CallStack, UsageError) a)+runWithPool pool = runEff . runError @UsageError . runHasqlIO pool

+ test/Main.hs view

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."