New Version - Master

.github/workflows/ci.yml

@@ -7,7 +7,7 @@ on:
     branches: [ dev ]
 
 jobs:
-  ghc9_0:
+  ghc_default:
     runs-on: ubuntu-latest
 
     services:
@@ -23,8 +23,8 @@ jobs:
         options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
 
     steps:
-      - uses: actions/checkout@v2
-      - uses: haskell/actions/setup@v1
+      - uses: actions/checkout@v4
+      - uses: haskell-actions/setup@v2
         with:
           enable-stack: true
           stack-version: 'latest'
@@ -50,13 +50,13 @@ jobs:
         run: stack haddock --fast
 
       - name: cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: |
             ".stack-work"
             "/root/.stack/"
           key: ${{ runner.os }}-${{ hashFiles('**/lockfiles') }}
-  ghc8_10:
+  ghc9_4:
     runs-on: ubuntu-latest
 
     services:
@@ -73,18 +73,18 @@ jobs:
 
     steps:
       - uses: actions/checkout@v2
-      - uses: haskell/actions/setup@v1
+      - uses: haskell-actions/setup@v2
         with:
           enable-stack: true
           stack-version: 'latest'
           stack-no-global: true
           stack-setup-ghc: true
 
       - name: build
-        run: stack build --fast --stack-yaml stack-ghc8_10.yaml
+        run: stack build --fast --stack-yaml stack-ghc9_4.yaml
 
       - name: test
-        run: stack test --fast --stack-yaml stack-ghc8_10.yaml
+        run: stack test --fast --stack-yaml stack-ghc9_4.yaml
         env:
           PG_USER: postgres
           PG_HOST: localhost
@@ -93,19 +93,19 @@ jobs:
           PG_PORT: ${{ job.services.postgres.ports['5432'] }}
 
       - name: benchmark
-        run: stack bench --fast --stack-yaml stack-ghc8_10.yaml
+        run: stack bench --fast --stack-yaml stack-ghc9_4.yaml
 
       - name: documentation
-        run: stack haddock --fast --stack-yaml stack-ghc8_10.yaml
+        run: stack haddock --fast --stack-yaml stack-ghc9_4.yaml
 
       - name: cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: |
             ".stack-work"
             "/root/.stack/"
           key: ${{ runner.os }}-${{ hashFiles('**/lockfiles') }}
-  ghc8_8:
+  ghc9_2:
     runs-on: ubuntu-latest
 
     services:
@@ -122,18 +122,18 @@ jobs:
 
     steps:
       - uses: actions/checkout@v2
-      - uses: haskell/actions/setup@v1
+      - uses: haskell-actions/setup@v2
         with:
           enable-stack: true
           stack-version: 'latest'
           stack-no-global: true
           stack-setup-ghc: true
 
       - name: build
-        run: stack build --fast --stack-yaml stack-ghc8_8.yaml
+        run: stack build --fast --stack-yaml stack-ghc9_2.yaml
 
       - name: test
-        run: stack test --fast --stack-yaml stack-ghc8_8.yaml
+        run: stack test --fast --stack-yaml stack-ghc9_2.yaml
         env:
           PG_USER: postgres
           PG_HOST: localhost
@@ -142,13 +142,13 @@ jobs:
           PG_PORT: ${{ job.services.postgres.ports['5432'] }}
 
       - name: benchmark
-        run: stack bench --fast --stack-yaml stack-ghc8_8.yaml
+        run: stack bench --fast --stack-yaml stack-ghc9_2.yaml
 
       - name: documentation
-        run: stack haddock --fast --stack-yaml stack-ghc8_8.yaml
+        run: stack haddock --fast --stack-yaml stack-ghc9_2.yaml
 
       - name: cache
-        uses: actions/cache@v2
+        uses: actions/cache@v3
         with:
           path: |
             ".stack-work"

README.md

@@ -2,7 +2,7 @@
 
 ![squeal-icon](https://raw.githubusercontent.com/morphismtech/squeal/dev/squeal.gif)
 
-[![GitHub CI](https://github.com/morphismtech/squeal/workflows/CI/badge.svg)](https://github.com/morphismtech/squeal/actions)
+[![GithubWorkflowCI](https://github.com/morphismtech/squeal/actions/workflows/ci.yml/badge.svg)](https://github.com/morphismtech/squeal/actions/workflows/ci.yml)
 
 [Github](https://github.com/morphismtech/squeal)
 
@@ -63,6 +63,7 @@ composable and cover a large portion of SQL.
 ## testing
 
 Start postgres on localhost port `5432` and create a database named `exampledb`.
+On macOS, you can create the database using `createdb exampledb`.
 
 `stack test`
 

RELEASE NOTES.md

@@ -1,5 +1,13 @@
 ## RELEASE NOTES
 
+## Version 0.9.2.0
+
+Thanks to MangoIV, Peter Becich, Daniel Gasienica and Michael Xavier Well
+for their contributions!
+
+Fixes for various bugs and updates added as well as some new array functions
+and array decoding functionality.
+
 ## Version 0.9.0.0
 
 Thanks to William Yao and Cullin Poresky for their contributions!

squeal-postgresql/README.md

@@ -2,7 +2,7 @@
 
 ![squeal-icon](https://raw.githubusercontent.com/morphismtech/squeal/dev/squeal.gif)
 
-[![CircleCI](https://circleci.com/gh/echatav/squeal.svg?style=svg&circle-token=a699a654ef50db2c3744fb039cf2087c484d1226)](https://circleci.com/gh/morphismtech/squeal)
+[![GithubWorkflowCI](https://github.com/morphismtech/squeal/actions/workflows/ci.yml/badge.svg)](https://github.com/morphismtech/squeal/actions/workflows/ci.yml)
 
 [Github](https://github.com/morphismtech/squeal)
 

squeal-postgresql/exe/Example.hs

@@ -9,8 +9,15 @@
   , TypeOperators
 #-}
 
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
 module Main (main, main2, upsertUser) where
 
+import Control.Monad.Except (MonadError (throwError))
 import Control.Monad.IO.Class (MonadIO (..))
 import Data.Int (Int16, Int32)
 import Data.Text (Text)
@@ -46,6 +53,7 @@ type OrgSchema =
         '[ "pk_organizations" ::: 'PrimaryKey '["id"] ] :=>
         '[ "id" ::: 'Def :=> 'NotNull 'PGint4
          , "name" ::: 'NoDef :=> 'NotNull 'PGtext
+         , "type" ::: 'NoDef :=> 'NotNull 'PGtext
          ])
    , "members" ::: 'Table (
         '[ "fk_member" ::: 'ForeignKey '["member"] "user" "users" '["id"]
@@ -54,7 +62,7 @@ type OrgSchema =
          , "organization" ::: 'NoDef :=> 'NotNull 'PGint4 ])
    ]
 
-type Schemas 
+type Schemas
   = '[ "public" ::: PublicSchema, "user" ::: UserSchema, "org" ::: OrgSchema ]
 
 setup :: Definition (Public '[]) Schemas
@@ -83,7 +91,8 @@ setup =
   >>>
   createTable (#org ! #organizations)
     ( serial `as` #id :*
-      (text & notNullable) `as` #name )
+      (text & notNullable) `as` #name :*
+      (text & notNullable) `as` #type )
     ( primaryKey #id `as` #pk_organizations )
   >>>
   createTable (#org ! #members)
@@ -93,7 +102,7 @@ setup =
         (OnDelete Cascade) (OnUpdate Cascade) `as` #fk_member :*
       foreignKey #organization (#org ! #organizations) #id
         (OnDelete Cascade) (OnUpdate Cascade) `as` #fk_organization )
-      
+
 teardown :: Definition Schemas (Public '[])
 teardown = dropType #positive >>> dropSchemaCascade #user >>> dropSchemaCascade #org
 
@@ -106,13 +115,48 @@ insertEmail :: Manipulation_ Schemas (Int32, Maybe Text) ()
 insertEmail = insertInto_ (#user ! #emails)
   (Values_ (Default `as` #id :* Set (param @1) `as` #user_id :* Set (param @2) `as` #email))
 
+insertOrganization :: Manipulation_ Schemas (Text, OrganizationType) (Only Int32)
+insertOrganization = insertInto (#org ! #organizations)
+  (Values_ (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #type))
+  (OnConflict (OnConstraint #pk_organizations) DoNothing) (Returning_ (#id `as` #fromOnly))
+
 getUsers :: Query_ Schemas () User
 getUsers = select_
   (#u ! #name `as` #userName :* #e ! #email `as` #userEmail :* #u ! #vec `as` #userVec)
   ( from (table ((#user ! #users) `as` #u)
     & innerJoin (table ((#user ! #emails) `as` #e))
       (#u ! #id .== #e ! #user_id)) )
 
+getOrganizations :: Query_ Schemas () Organization
+getOrganizations = select_
+  ( #o ! #id `as` #orgId :*
+    #o ! #name `as` #orgName :*
+    #o ! #type `as` #orgType
+  )
+  (from (table (#org ! #organizations `as` #o)))
+
+getOrganizationsBy ::
+  forall hsty.
+  (ToPG Schemas hsty) =>
+  Condition
+    'Ungrouped
+    '[]
+    '[]
+    Schemas
+    '[NullPG hsty]
+    '["o" ::: ["id" ::: NotNull PGint4, "name" ::: NotNull PGtext, "type" ::: NotNull PGtext]] ->
+  Query_ Schemas (Only hsty) Organization
+getOrganizationsBy condition =
+  select_
+    ( #o ! #id `as` #orgId :*
+      #o ! #name `as` #orgName :*
+      #o ! #type `as` #orgType
+    )
+    (
+      from (table (#org ! #organizations `as` #o))
+      & where_ condition
+    )
+
 upsertUser :: Manipulation_ Schemas (Int32, String, VarArray [Maybe Int16]) ()
 upsertUser = insertInto (#user ! #users `as` #u)
   (Values_ (Set (param @1) `as` #id :* setUser))
@@ -137,28 +181,98 @@ users =
   , User "Carole" (Just "carole@hotmail.com") (VarArray [Just 3,Nothing, Just 4])
   ]
 
+data Organization
+  = Organization
+  { orgId :: Int32
+  , orgName :: Text
+  , orgType :: OrganizationType
+  } deriving (Show, GHC.Generic)
+instance SOP.Generic Organization
+instance SOP.HasDatatypeInfo Organization
+
+data OrganizationType
+  = ForProfit
+  | NonProfit
+  deriving (Show, GHC.Generic)
+instance SOP.Generic OrganizationType
+instance SOP.HasDatatypeInfo OrganizationType
+
+instance IsPG OrganizationType where
+  type PG OrganizationType = 'PGtext
+instance ToPG db OrganizationType where
+  toPG = toPG . toText
+    where
+      toText ForProfit = "for-profit" :: Text
+      toText NonProfit = "non-profit" :: Text
+
+instance FromPG OrganizationType where
+  fromPG = do
+    value <- fromPG @Text
+    fromText value
+    where
+      fromText "for-profit" = pure ForProfit
+      fromText "non-profit" = pure NonProfit
+      fromText value = throwError $ "Invalid organization type: \"" <> value <> "\""
+
+organizations :: [Organization]
+organizations =
+  [ Organization { orgId = 1, orgName = "ACME", orgType = ForProfit }
+  , Organization { orgId = 2, orgName = "Haskell Foundation", orgType = NonProfit }
+  ]
+
 session :: (MonadIO pq, MonadPQ Schemas pq) => pq ()
 session = do
-  liftIO $ Char8.putStrLn "manipulating"
-  idResults <- traversePrepared insertUser ([(userName user, userVec user) | user <- users])
-  ids <- traverse (fmap fromOnly . getRow 0) (idResults :: [Result (Only Int32)])
-  traversePrepared_ insertEmail (zip (ids :: [Int32]) (userEmail <$> users))
-  liftIO $ Char8.putStrLn "querying"
+  liftIO $ Char8.putStrLn "===> manipulating"
+  userIdResults <- traversePrepared insertUser [(userName user, userVec user) | user <- users]
+  userIds <- traverse (fmap fromOnly . getRow 0) (userIdResults :: [Result (Only Int32)])
+  traversePrepared_ insertEmail (zip (userIds :: [Int32]) (userEmail <$> users))
+
+  orgIdResults <- traversePrepared
+    insertOrganization
+    [(orgName organization, orgType organization) | organization <- organizations]
+  _ <- traverse (fmap fromOnly . getRow 0) (orgIdResults :: [Result (Only Int32)])
+
+  liftIO $ Char8.putStrLn "===> querying: users"
   usersResult <- runQuery getUsers
   usersRows <- getRows usersResult
   liftIO $ print (usersRows :: [User])
 
+  liftIO $ Char8.putStrLn "===> querying: organizations: all"
+  organizationsResult1 <- runQuery getOrganizations
+  organizationRows1 <- getRows organizationsResult1
+  liftIO $ print (organizationRows1 :: [Organization])
+
+  liftIO $ Char8.putStrLn "===> querying: organizations: by ID (2)"
+  organizationsResult2 <- runQueryParams
+    (getOrganizationsBy @Int32 ((#o ! #id) .== param @1)) (Only (2 :: Int32))
+  organizationRows2 <- getRows organizationsResult2
+  liftIO $ print (organizationRows2 :: [Organization])
+
+  liftIO $ Char8.putStrLn "===> querying: organizations: by name (ACME)"
+  organizationsResult3 <- runQueryParams
+    (getOrganizationsBy @Text ((#o ! #name) .== param @1)) (Only ("ACME" :: Text))
+  organizationRows3 <- getRows organizationsResult3
+  liftIO $ print (organizationRows3 :: [Organization])
+
+  liftIO $ Char8.putStrLn "===> querying: organizations: by type (non-profit)"
+  organizationsResult4 <- runQueryParams
+    (getOrganizationsBy @Text ((#o ! #type) .== param @1)) (Only NonProfit)
+  organizationRows4 <- getRows organizationsResult4
+  liftIO $ print (organizationRows4 :: [Organization])
+
 main :: IO ()
 main = do
-  Char8.putStrLn "squeal"
+  Char8.putStrLn "===> squeal"
   connectionString <- pure
     "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
   Char8.putStrLn $ "connecting to " <> connectionString
   connection0 <- connectdb connectionString
-  Char8.putStrLn "setting up schema"
+
+  Char8.putStrLn "===> setting up schema"
   connection1 <- execPQ (define setup) connection0
   connection2 <- execPQ session connection1
-  Char8.putStrLn "tearing down schema"
+
+  Char8.putStrLn "===> tearing down schema"
   connection3 <- execPQ (define teardown) connection2
   finish connection3
 

squeal-postgresql/squeal-postgresql.cabal

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 name: squeal-postgresql
-version: 0.9.1.3
+version: 0.9.2.0
 synopsis: Squeal PostgreSQL Library
 description: Squeal is a type-safe embedding of PostgreSQL in Haskell
 homepage: https://github.com/morphismtech/squeal
@@ -99,6 +99,7 @@ library
     , free-categories >= 0.2.0.0
     , generics-sop >= 0.5.1.0
     , hashable >= 1.3.0.0
+    , iproute >= 1.7.0
     , mmorph >= 1.1.3
     , monad-control >= 1.0.2.3
     , mtl >= 2.2.2