Make examples compile

examples/Catalog.hs

@@ -1,20 +1,18 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards
-  , ScopedTypeVariables, TypeFamilies #-}
-{-# OPTIONS_GHC -Wall #-}
+module Catalog (catalog) where
 
 import Control.Arrow (second)
 import Control.Monad
 import Control.Monad.Base
 import Control.Monad.Catch
 import Data.Function
 import Data.Int
-import Data.Monoid
 import Data.Monoid.Utils
+import Data.Pool
+import Data.Text qualified as T
 import Database.PostgreSQL.PQTypes
 import Database.PostgreSQL.PQTypes.Internal.Utils (mread)
 import System.Console.Readline
 import System.Environment
-import qualified Data.ByteString.Char8 as BS
 
 -- | Generic 'putStrLn'.
 printLn :: MonadBase IO m => String -> m ()
@@ -25,7 +23,7 @@ getConnSettings :: IO ConnectionSettings
 getConnSettings = do
   args <- getArgs
   case args of
-    [conninfo] -> return def { csConnInfo = BS.pack conninfo }
+    [conninfo] -> return defaultConnectionSettings {csConnInfo = T.pack conninfo}
     _ -> do
       prog <- getProgName
       error $ "Usage:" <+> prog <+> "<connection info>"
@@ -34,10 +32,11 @@ getConnSettings = do
 
 -- | Representation of a book.
 data Book = Book
-  { bookID       :: Int64
-  , bookName     :: String
-  , bookYear     :: Int32
-  } deriving (Read, Show)
+  { bookID :: Int64
+  , bookName :: String
+  , bookYear :: Int32
+  }
+  deriving (Read, Show)
 
 -- | Intermediate representation of 'Book'.
 type instance CompositeRow Book = (Int64, String, Int32)
@@ -46,78 +45,87 @@ instance PQFormat Book where
   pqFormat = "%book_"
 
 instance CompositeFromSQL Book where
-  toComposite (bid, name, year) = Book {
-    bookID = bid
-  , bookName = name
-  , bookYear = year
-  }
+  toComposite (bid, name, year) =
+    Book
+      { bookID = bid
+      , bookName = name
+      , bookYear = year
+      }
 
 withCatalog :: ConnectionSettings -> IO () -> IO ()
-withCatalog cs = bracket_ createStructure dropStructure
+withCatalog settings = bracket_ createStructure dropStructure
   where
-    -- | Create needed tables and types.
-    createStructure = runDBT (simpleSource cs) def $ do
+    ConnectionSource cs = simpleSource settings
+
+    -- Create needed tables and types.
+    createStructure = runDBT cs defaultTransactionSettings $ do
       printLn "Creating tables..."
-      runSQL_ $ mconcat [
-          "CREATE TABLE authors_ ("
-        , "  id BIGSERIAL NOT NULL"
-        , ", name TEXT NOT NULL"
-        , ", PRIMARY KEY (id)"
-        , ")"
-        ]
-      runSQL_ $ mconcat [
-          "CREATE TABLE books_ ("
-        , "  id BIGSERIAL NOT NULL"
-        , ", name TEXT NOT NULL"
-        , ", year INTEGER NOT NULL"
-        , ", author_id BIGINT NOT NULL"
-        , ", PRIMARY KEY (id)"
-        , ", FOREIGN KEY (author_id) REFERENCES authors_ (id)"
-        , ")"
-        ]
-      runSQL_ $ mconcat [
-          "CREATE TYPE book_ AS ("
-        , "  id BIGINT"
-        , ", name TEXT"
-        , ", year INTEGER"
-        , ")"
-        ]
-    -- | Drop previously created database structures.
-    dropStructure = runDBT (simpleSource cs) def $ do
+      runSQL_ $
+        mconcat
+          [ "CREATE TABLE authors_ ("
+          , "  id BIGSERIAL NOT NULL"
+          , ", name TEXT NOT NULL"
+          , ", PRIMARY KEY (id)"
+          , ")"
+          ]
+      runSQL_ $
+        mconcat
+          [ "CREATE TABLE books_ ("
+          , "  id BIGSERIAL NOT NULL"
+          , ", name TEXT NOT NULL"
+          , ", year INTEGER NOT NULL"
+          , ", author_id BIGINT NOT NULL"
+          , ", PRIMARY KEY (id)"
+          , ", FOREIGN KEY (author_id) REFERENCES authors_ (id)"
+          , ")"
+          ]
+      runSQL_ $
+        mconcat
+          [ "CREATE TYPE book_ AS ("
+          , "  id BIGINT"
+          , ", name TEXT"
+          , ", year INTEGER"
+          , ")"
+          ]
+    -- Drop previously created database structures.
+    dropStructure = runDBT cs defaultTransactionSettings $ do
       printLn "Dropping tables..."
       runSQL_ "DROP TYPE book_"
       runSQL_ "DROP TABLE books_"
       runSQL_ "DROP TABLE authors_"
 
 ----------------------------------------
 
-processCommand :: ConnectionSource -> String -> IO ()
+processCommand :: ConnectionSourceM IO -> String -> IO ()
 processCommand cs cmd = case parse cmd of
-  -- | Display authors.
-  ("authors", "") -> runDBT cs def $ do
+  -- Display authors.
+  ("authors", "") -> runDBT cs defaultTransactionSettings $ do
     runSQL_ "SELECT * FROM authors_ ORDER BY name"
-    mapDB_ $ \(aid::Int64, name) -> printLn $ show aid <> ":" <+> name
-  -- | Display books.
-  ("books", "") -> runDBT cs def $ do
+    mapDB_ $ \(aid :: Int64, name) -> printLn $ show aid <> ":" <+> name
+  -- Display books.
+  ("books", "") -> runDBT cs defaultTransactionSettings $ do
     runSQL_ "SELECT a.name, ARRAY(SELECT (b.id, b.name, b.year)::book_ FROM books_ b WHERE b.author_id = a.id) FROM authors_ a ORDER BY a.name"
-    mapDB_ $ \(author, CompositeArray1 (books::[Book])) -> do
+    mapDB_ $ \(author, CompositeArray1 (books :: [Book])) -> do
       printLn $ author <> ":"
       forM_ books $ \book -> printLn $ "*" <+> show book
-  -- | Insert an author.
+  -- Insert an author.
   ("insert_author", mname) -> case mread mname of
-    Just (name::String) -> runDBT cs def . runQuery_ $
-      "INSERT INTO authors_ (name) VALUES (" <?> name <+> ")"
+    Just (name :: String) ->
+      runDBT cs defaultTransactionSettings . runQuery_ $
+        "INSERT INTO authors_ (name) VALUES (" <?> name <+> ")"
     Nothing -> printLn $ "Invalid name"
-  -- | Insert a book.
+  -- Insert a book.
   ("insert_book", mbook) -> case mread mbook of
-    Just record -> runDBT cs def . runQuery_ $ rawSQL
-      "INSERT INTO books_ (name, year, author_id) VALUES ($1, $2, $3)"
-      (record::(String, Int32, Int64))
+    Just record ->
+      runDBT cs defaultTransactionSettings . runQuery_ $
+        rawSQL
+          "INSERT INTO books_ (name, year, author_id) VALUES ($1, $2, $3)"
+          (record :: (String, Int32, Int64))
     Nothing -> printLn $ "Invalid book record"
-  -- | Handle unknown commands.
+  -- Handle unknown commands.
   _ -> printLn $ "Unknown command:" <+> cmd
   where
-    parse = second (drop 1) . break (==' ')
+    parse = second (drop 1) . break (== ' ')
 
 -- | Example chain of commands:
 --
@@ -131,14 +139,18 @@ processCommand cs cmd = case parse cmd of
 --
 -- If you want to check out exceptions in action,
 -- try inserting a book with invalid author id.
-main :: IO ()
-main = do
+catalog :: IO ()
+catalog = do
   cs <- getConnSettings
   withCatalog cs $ do
-    pool <- poolSource (cs { csComposites = ["book_"] }) 1 10 4
-    fix $ \next -> readline "> " >>= maybe (printLn "") (\cmd -> do
-      when (cmd /= "quit") $ do
-        processCommand pool cmd
-        addHistory cmd
-        next
-      )
+    ConnectionSource pool <- poolSource (cs {csComposites = ["book_"]}) (\connect disconnect -> defaultPoolConfig connect disconnect 1 10)
+    fix $ \next ->
+      readline "> "
+        >>= maybe
+          (printLn "")
+          ( \cmd -> do
+              when (cmd /= "quit") $ do
+                processCommand pool cmd
+                addHistory cmd
+                next
+          )

hpqtypes.cabal

@@ -178,6 +178,12 @@ test-suite hpqtypes-tests
   other-modules:     Prelude.Instances
                      Test.Aeson.Compat
                      Test.QuickCheck.Arbitrary.Instances
+
+  -- make sure examples compile
+  hs-source-dirs:    examples
+  other-modules:     Catalog
+                     OuterJoins
+
   build-depends:       hpqtypes
                      , base >= 4.14 && < 5
                      , HUnit >= 1.2
@@ -189,6 +195,8 @@ test-suite hpqtypes-tests
                      , monad-control >= 1.0.3
                      , mtl >= 2.1
                      , random >= 1.0
+                     , readline >= 1.0.3.0
+                     , resource-pool >= 0.4
                      , scientific
                      , test-framework >= 0.8
                      , test-framework-hunit >= 0.3

src/Database/PostgreSQL/PQTypes/Internal/C/Types.hsc

@@ -43,8 +43,8 @@ import Foreign.ForeignPtr
 import Foreign.Marshal.Array
 import Foreign.Ptr
 import Foreign.Storable
-import qualified Data.ByteString as BS
-import qualified Data.Vector.Storable as V
+import Data.ByteString qualified as BS
+import Data.Vector.Storable qualified as V
 
 data PGcancel
 data PGconn

src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc

@@ -12,10 +12,10 @@ import Foreign.Ptr
 import Foreign.Storable
 import System.Posix.Types
 import System.Timeout
-import qualified Control.Exception as E
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
+import Control.Exception qualified as E
+import Data.ByteString.Char8 qualified as BS
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
 
 import Database.PostgreSQL.PQTypes.Internal.C.Interface
 import Database.PostgreSQL.PQTypes.Internal.C.Types

src/Database/PostgreSQL/PQTypes/Interval.hsc

@@ -12,8 +12,8 @@ module Database.PostgreSQL.PQTypes.Interval (
 import Data.Int
 import Data.List
 import Foreign.Storable
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.Semigroup as SG
+import Data.ByteString.Char8 qualified as BS
+import Data.Semigroup qualified as SG
 
 import Database.PostgreSQL.PQTypes.Format
 import Database.PostgreSQL.PQTypes.FromSQL

test/Test/Aeson/Compat.hs

@@ -13,8 +13,8 @@ import Data.Text (Text)
 #if MIN_VERSION_aeson(2,0,0)
 
 import Data.Bifunctor (first)
-import qualified Data.Aeson.Key as K
-import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.Key qualified as K
+import Data.Aeson.KeyMap qualified as KM
 
 import Database.PostgreSQL.PQTypes.Internal.C.Types
 import Database.PostgreSQL.PQTypes
@@ -46,7 +46,7 @@ mkValue0 = Value0
 
 #else
 
-import qualified Data.HashMap.Strict as HM
+import Data.HashMap.Strict qualified as HM
 
 fromList :: [(Text, v)] -> HM.HashMap Text v
 fromList = HM.fromList