diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d7989fde..6b206078 100644 --- a/.github/workflows/ci.yml +++ b/.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,7 +73,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 + - uses: haskell-actions/setup@v2 with: enable-stack: true stack-version: 'latest' @@ -81,10 +81,10 @@ jobs: 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,7 +122,7 @@ jobs: steps: - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 + - uses: haskell-actions/setup@v2 with: enable-stack: true stack-version: 'latest' @@ -130,10 +130,10 @@ jobs: 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" diff --git a/README.md b/README.md index cace7055..27143f6e 100644 --- a/README.md +++ b/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` diff --git a/RELEASE NOTES.md b/RELEASE NOTES.md index 6daa97c7..23b4f25b 100644 --- a/RELEASE NOTES.md +++ b/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! diff --git a/squeal-postgresql/README.md b/squeal-postgresql/README.md index 1cd89548..775a88c4 100644 --- a/squeal-postgresql/README.md +++ b/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) diff --git a/squeal-postgresql/exe/Example.hs b/squeal-postgresql/exe/Example.hs index 6fe3cd9d..88772bff 100644 --- a/squeal-postgresql/exe/Example.hs +++ b/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,6 +115,11 @@ 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) @@ -113,6 +127,36 @@ getUsers = select_ & 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 diff --git a/squeal-postgresql/squeal-postgresql.cabal b/squeal-postgresql/squeal-postgresql.cabal index 8fa67808..699b212c 100644 --- a/squeal-postgresql/squeal-postgresql.cabal +++ b/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 diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Array.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Array.hs index c35e8b74..003d36b0 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Array.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Expression/Array.hs @@ -37,6 +37,15 @@ module Squeal.PostgreSQL.Expression.Array , unnest , arrAny , arrAll + , arrayAppend + , arrayPrepend + , arrayCat + , arrayPosition + , arrayPositionBegins + , arrayPositions + , arrayRemoveNull + , arrayReplace + , trimArray ) where import Data.String @@ -47,6 +56,7 @@ import qualified Generics.SOP as SOP import Squeal.PostgreSQL.Expression import Squeal.PostgreSQL.Expression.Logic +import Squeal.PostgreSQL.Expression.Null import Squeal.PostgreSQL.Expression.Type import Squeal.PostgreSQL.Query.From.Set import Squeal.PostgreSQL.Render @@ -240,3 +250,42 @@ arrAny -> Expression grp lat with db params from (null ('PGvararray ty2)) -- ^ array -> Condition grp lat with db params from arrAny x (?) xs = x ? (UnsafeExpression $ "ANY" <+> parenthesized (renderSQL xs)) + +arrayAppend :: '[null ('PGvararray ty), ty] ---> null ('PGvararray ty) +arrayAppend = unsafeFunctionN "array_append" + +arrayPrepend :: '[ty, null ('PGvararray ty)] ---> null ('PGvararray ty) +arrayPrepend = unsafeFunctionN "array_prepend" + +arrayCat + :: '[null ('PGvararray ty), null ('PGvararray ty)] + ---> null ('PGvararray ty) +arrayCat = unsafeFunctionN "array_cat" + +arrayPosition :: '[null ('PGvararray ty), ty] ---> 'Null 'PGint8 +arrayPosition = unsafeFunctionN "array_position" + +arrayPositionBegins + :: '[null ('PGvararray ty), ty, null 'PGint8] ---> 'Null 'PGint8 +arrayPositionBegins = unsafeFunctionN "array_position" + +arrayPositions + :: '[null ('PGvararray ty), ty] + ---> null ('PGvararray ('NotNull 'PGint8)) +arrayPositions = unsafeFunctionN "array_positions" + +arrayRemove :: '[null ('PGvararray ty), ty] ---> null ('PGvararray ty) +arrayRemove = unsafeFunctionN "array_remove" + +arrayRemoveNull :: null ('PGvararray ('Null ty)) --> null ('PGvararray ('NotNull ty)) +arrayRemoveNull arr = UnsafeExpression (renderSQL (arrayRemove (arr *: null_))) + +arrayReplace + :: '[null ('PGvararray ty), ty, ty] + ---> null ('PGvararray ty) +arrayReplace = unsafeFunctionN "array_replace" + +trimArray + :: '[null ('PGvararray ty), 'NotNull 'PGint8] + ---> null ('PGvararray ty) +trimArray = unsafeFunctionN "trim_array" diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Session.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Session.hs index 9adf2324..71ad1cce 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Session.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Session.hs @@ -44,9 +44,8 @@ import Control.Monad (MonadPlus(..)) import Control.Monad.Base (MonadBase(..)) import Control.Monad.Fix (MonadFix(..)) import Control.Monad.Catch -import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Morph -import Control.Monad.Reader (ReaderT(..)) +import Control.Monad.Reader import Control.Monad.Trans.Control (MonadBaseControl(..), MonadTransControl(..)) import UnliftIO (MonadUnliftIO(..)) import Data.ByteString (ByteString) @@ -214,9 +213,9 @@ instance (Monad m, db0 ~ db1) return = pure (>>=) = flip pqBind -instance (Monad m, db0 ~ db1) +instance (MonadFail m, db0 ~ db1) => Fail.MonadFail (PQ db0 db1 m) where - fail = Fail.fail + fail = lift . Fail.fail instance db0 ~ db1 => MFunctor (PQ db0 db1) where hoist f (PQ pq) = PQ (f . pq) diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Decode.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Decode.hs index b52ddb06..80e2ebfe 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Decode.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Decode.hs @@ -43,6 +43,7 @@ module Squeal.PostgreSQL.Session.Decode , genericProductRow , appendRows , consRow + , ArrayField (..) -- * Decoding Classes , FromValue (..) , FromField (..) @@ -68,6 +69,11 @@ import Data.Bits import Data.Coerce (coerce) import Data.Functor.Constant (Constant(Constant)) import Data.Int (Int16, Int32, Int64) +#if MIN_VERSION_postgresql_binary(0, 14, 0) +import Data.IP (IPRange) +#else +import Network.IP.Addr (NetAddr, IP) +#endif import Data.Kind import Data.Scientific (Scientific) import Data.String (fromString) @@ -78,7 +84,6 @@ import Data.Vector (Vector) import Database.PostgreSQL.LibPQ (Oid(Oid)) import GHC.OverloadedLabels import GHC.TypeLits -import Network.IP.Addr (NetAddr, IP) import PostgreSQL.Binary.Decoding hiding (Composite) import Unsafe.Coerce @@ -200,8 +205,11 @@ instance FromPG Money where fromPG = devalue $ Money <$> int instance FromPG UUID where fromPG = devalue uuid -instance FromPG (NetAddr IP) where - fromPG = devalue inet +#if MIN_VERSION_postgresql_binary(0, 14, 0) +instance FromPG IPRange where fromPG = devalue inet +#else +instance FromPG (NetAddr IP) where fromPG = devalue inet +#endif instance FromPG Char where fromPG = devalue char instance FromPG Strict.Text where @@ -533,6 +541,42 @@ instance {-# OVERLAPPABLE #-} IsLabel fld (MaybeT (DecodeRow row) y) fromLabel = MaybeT . decodeRow $ \(_ SOP.:* bs) -> runDecodeRow (runMaybeT (fromLabel @fld)) bs +{- | Utility for decoding array fields in a `DecodeRow`, +accessed via overloaded labels. +-} +newtype ArrayField row y = ArrayField + { runArrayField + :: StateT Strict.ByteString (Except Strict.Text) y + -> DecodeRow row [y] + } +instance {-# OVERLAPPING #-} + ( KnownSymbol fld + , PG y ~ ty + , arr ~ 'NotNull ('PGvararray ('NotNull ty)) + ) => IsLabel fld (ArrayField (fld ::: arr ': row) y) where + fromLabel = ArrayField $ \yval -> + decodeRow $ \(SOP.K bytesMaybe SOP.:* _) -> do + let + flderr = mconcat + [ "field name: " + , "\"", fromString (symbolVal (SOP.Proxy @fld)), "\"; " + ] + yarr + = devalue + . array + . dimensionArray replicateM + . valueArray + . revalue + $ yval + case bytesMaybe of + Nothing -> Left (flderr <> "encountered unexpected NULL") + Just bytes -> runExcept (evalStateT yarr bytes) +instance {-# OVERLAPPABLE #-} IsLabel fld (ArrayField row y) + => IsLabel fld (ArrayField (field ': row) y) where + fromLabel = ArrayField $ \yval -> + decodeRow $ \(_ SOP.:* bytess) -> + runDecodeRow (runArrayField (fromLabel @fld) yval) bytess + -- | A `GenericRow` constraint to ensure that a Haskell type -- is a record type, -- has a `RowPG`, diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Encode.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Encode.hs index f917d8c3..b3641dd3 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Encode.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Encode.hs @@ -11,6 +11,7 @@ encoding of statement parameters {-# LANGUAGE AllowAmbiguousTypes , ConstraintKinds + , CPP , DataKinds , DefaultSignatures , FlexibleContexts @@ -59,6 +60,11 @@ import Data.Functor.Const (Const(Const)) import Data.Functor.Constant (Constant(Constant)) import Data.Functor.Contravariant import Data.Int (Int16, Int32, Int64) +#if MIN_VERSION_postgresql_binary(0, 14, 0) +import Data.IP (IPRange) +#else +import Network.IP.Addr (NetAddr, IP) +#endif import Data.Kind import Data.Scientific (Scientific) import Data.Text as Strict (Text) @@ -69,7 +75,6 @@ import Data.Vector (Vector) import Data.Word (Word32) import Foreign.C.Types (CUInt(CUInt)) import GHC.TypeLits -import Network.IP.Addr (NetAddr, IP) import PostgreSQL.Binary.Encoding hiding (Composite, field) import qualified Data.Aeson as Aeson @@ -121,7 +126,11 @@ instance ToPG db Double where toPG = pure . float8 instance ToPG db Scientific where toPG = pure . numeric instance ToPG db Money where toPG = pure . int8_int64 . cents instance ToPG db UUID where toPG = pure . uuid +#if MIN_VERSION_postgresql_binary(0, 14, 0) +instance ToPG db IPRange where toPG = pure . inet +#else instance ToPG db (NetAddr IP) where toPG = pure . inet +#endif instance ToPG db Char where toPG = pure . char_utf8 instance ToPG db Strict.Text where toPG = pure . text_strict instance ToPG db Lazy.Text where toPG = pure . text_lazy diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Oid.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Oid.hs index 5380e731..d8c67289 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Session/Oid.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Session/Oid.hs @@ -36,7 +36,7 @@ module Squeal.PostgreSQL.Session.Oid import Control.Monad (when) import Control.Monad.Catch (throwM) -import Control.Monad.Reader (ReaderT(ReaderT)) +import Control.Monad.Reader import Data.String import GHC.TypeLits import PostgreSQL.Binary.Decoding (valueParser, int) diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Type/PG.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Type/PG.hs index c7ecef25..8ae4ebc5 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Type/PG.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Type/PG.hs @@ -10,6 +10,7 @@ into corresponding Postgres types. -} {-# LANGUAGE AllowAmbiguousTypes + , CPP , DeriveAnyClass , DeriveFoldable , DeriveFunctor @@ -57,12 +58,16 @@ import Data.Functor.Const (Const) import Data.Functor.Constant (Constant) import Data.Kind (Type) import Data.Int (Int16, Int32, Int64) +#if MIN_VERSION_postgresql_binary(0, 14, 0) +import Data.IP (IPRange) +#else +import Network.IP.Addr (NetAddr, IP) +#endif import Data.Scientific (Scientific) import Data.Time (Day, DiffTime, LocalTime, TimeOfDay, TimeZone, UTCTime) import Data.Vector (Vector) import Data.UUID.Types (UUID) import GHC.TypeLits -import Network.IP.Addr (NetAddr, IP) import qualified Data.ByteString.Lazy as Lazy (ByteString) import qualified Data.ByteString as Strict (ByteString) @@ -166,7 +171,11 @@ instance IsPG DiffTime where type PG DiffTime = 'PGinterval -- | `PGuuid` instance IsPG UUID where type PG UUID = 'PGuuid -- | `PGinet` +#if MIN_VERSION_postgresql_binary(0, 14, 0) +instance IsPG IPRange where type PG IPRange = 'PGinet +#else instance IsPG (NetAddr IP) where type PG (NetAddr IP) = 'PGinet +#endif -- | `PGjson` instance IsPG Value where type PG Value = 'PGjson -- | `PGvarchar` diff --git a/stack-ghc9_6.yaml b/stack-ghc9_6.yaml deleted file mode 100644 index 895dc347..00000000 --- a/stack-ghc9_6.yaml +++ /dev/null @@ -1,7 +0,0 @@ -resolver: nightly-2023-08-29 -packages: -- squeal-postgresql -- squeal-postgresql-ltree -- squeal-postgresql-uuid-ossp -extra-deps: -- records-sop-0.1.1.1 diff --git a/stack.yaml b/stack.yaml index df8c0068..c5529aee 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-19.33 +resolver: lts-22.13 packages: - squeal-postgresql - squeal-postgresql-ltree