diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,7 +1,13 @@ -# 0.7.0.0 +# 0.7.2.0 +Add compatibility with GHC 8.4 and stack nightly + +# 0.7.1.0 + Note '0.7.1.0' was released because the signature of `delete` was too specific in '0.7.0.0' due to an error when uploading the package. + +# 0.7.0.0 ## Weaker functional dependencies on `MonadBeam` diff --git a/Database/Beam/Backend/SQL/Builder.hs b/Database/Beam/Backend/SQL/Builder.hs --- a/Database/Beam/Backend/SQL/Builder.hs +++ b/Database/Beam/Backend/SQL/Builder.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE CPP #-} -- | Provides a syntax 'SqlSyntaxBuilder' that uses a -- 'Data.ByteString.Builder.Builder' to construct SQL expressions as strings. @@ -29,10 +30,12 @@ import Data.Text (Text) import Data.Coerce -import Data.Int import Data.Hashable -import Data.Monoid +import Data.Int import Data.String +#if !MIN_VERSION_base(4, 11, 0) +import Data.Semigroup +#endif -- | The main syntax. A wrapper over 'Builder' newtype SqlSyntaxBuilder @@ -50,6 +53,9 @@ instance Eq SqlSyntaxBuilder where a == b = toLazyByteString (buildSql a) == toLazyByteString (buildSql b) + +instance Semigroup SqlSyntaxBuilder where + (<>) = mappend instance Monoid SqlSyntaxBuilder where mempty = SqlSyntaxBuilder mempty diff --git a/Database/Beam/Backend/URI.hs b/Database/Beam/Backend/URI.hs --- a/Database/Beam/Backend/URI.hs +++ b/Database/Beam/Backend/URI.hs @@ -1,5 +1,6 @@ --- | Convenience methods for constructing backend-agnostic applications +{-# LANGUAGE CPP #-} +-- | Convenience methods for constructing backend-agnostic applications module Database.Beam.Backend.URI where import Database.Beam.Backend.SQL @@ -7,6 +8,9 @@ import Control.Exception import qualified Data.Map as M +#if !MIN_VERSION_base(4, 11, 0) +import Data.Semigroup +#endif import Network.URI @@ -26,6 +30,9 @@ -> BeamURIOpener c newtype BeamURIOpeners c where BeamURIOpeners :: M.Map String (BeamURIOpener c) -> BeamURIOpeners c + +instance Semigroup (BeamURIOpeners c) where + (<>) = mappend instance Monoid (BeamURIOpeners c) where mempty = BeamURIOpeners mempty diff --git a/Database/Beam/Query/CustomSQL.hs b/Database/Beam/Query/CustomSQL.hs --- a/Database/Beam/Query/CustomSQL.hs +++ b/Database/Beam/Query/CustomSQL.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} -- | Allows the creation of custom SQL expressions from arbitrary string-like values. -- @@ -49,13 +50,15 @@ import Data.ByteString (ByteString) import Data.ByteString.Builder (byteString, toLazyByteString) import Data.ByteString.Lazy (toStrict) +#if !MIN_VERSION_base(4, 11, 0) +import Data.Semigroup +#endif -import Data.Monoid import Data.String import qualified Data.Text as T -- | A type-class for expression syntaxes that can embed custom expressions. -class (Monoid (CustomSqlSyntax syntax), IsString (CustomSqlSyntax syntax)) => +class (Monoid (CustomSqlSyntax syntax), Semigroup (CustomSqlSyntax syntax), IsString (CustomSqlSyntax syntax)) => IsCustomSqlSyntax syntax where data CustomSqlSyntax syntax :: * @@ -69,12 +72,14 @@ instance IsCustomSqlSyntax SqlSyntaxBuilder where newtype CustomSqlSyntax SqlSyntaxBuilder = SqlSyntaxBuilderCustom ByteString - deriving (IsString, Monoid) + deriving (IsString, Monoid, Semigroup) customExprSyntax (SqlSyntaxBuilderCustom bs) = SqlSyntaxBuilder (byteString bs) renderSyntax = SqlSyntaxBuilderCustom . toStrict . toLazyByteString . buildSql newtype CustomSqlSnippet syntax = CustomSqlSnippet (T.Text -> CustomSqlSyntax syntax) +instance IsCustomSqlSyntax syntax => Semigroup (CustomSqlSnippet syntax) where + (<>) = mappend instance IsCustomSqlSyntax syntax => Monoid (CustomSqlSnippet syntax) where mempty = CustomSqlSnippet (pure mempty) mappend (CustomSqlSnippet a) (CustomSqlSnippet b) = diff --git a/Database/Beam/Query/Internal.hs b/Database/Beam/Query/Internal.hs --- a/Database/Beam/Query/Internal.hs +++ b/Database/Beam/Query/Internal.hs @@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors#-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE CPP #-} module Database.Beam.Query.Internal where @@ -12,6 +13,9 @@ import qualified Data.DList as DList import Data.Typeable import Data.Vector.Sized (Vector) +#if !MIN_VERSION_base(4, 11, 0) +import Data.Semigroup +#endif import Control.Monad.Free.Church import Control.Monad.State @@ -117,7 +121,7 @@ newtype QAssignment fieldName expr s = QAssignment [(fieldName, expr)] - deriving (Show, Eq, Ord, Monoid) + deriving (Show, Eq, Ord, Monoid, Semigroup) -- * QGenExpr type diff --git a/beam-core.cabal b/beam-core.cabal --- a/beam-core.cabal +++ b/beam-core.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: beam-core -version: 0.7.1.0 +version: 0.7.2.0 synopsis: Type-safe, feature-complete SQL query and manipulation interface for Haskell description: Beam is a Haskell library for type-safe querying and manipulation of SQL databases. Beam is modular and supports various backends. In order to use beam, you will need to use @@ -64,7 +64,7 @@ hashable >=1.1 && <1.3, network-uri >=2.6 && <2.7, containers >=0.5 && <0.6, - vector-sized >=0.5 && <0.7, + vector-sized >=0.5 && <1.1, tagged >=0.8 && <0.9 Default-language: Haskell2010 default-extensions: ScopedTypeVariables, OverloadedStrings, GADTs, RecursiveDo, FlexibleInstances, FlexibleContexts, TypeFamilies, diff --git a/test/Database/Beam/Test/SQL.hs b/test/Database/Beam/Test/SQL.hs --- a/test/Database/Beam/Test/SQL.hs +++ b/test/Database/Beam/Test/SQL.hs @@ -878,7 +878,8 @@ where basicUnion = testCase "Basic UNION support" $ - do let hireDates = do e <- all_ (_employees employeeDbSettings) + do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s (Maybe _) ) + hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) @@ -899,7 +900,8 @@ fieldNamesCapturedCorrectly = testCase "UNION field names are propagated correctly" $ - do let hireDates = do e <- all_ (_employees employeeDbSettings) + do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) ) + hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) @@ -961,7 +963,8 @@ equalProjectionsDontHaveSubSelects = testCase "Equal projections dont have sub-selects" $ - do let hireDates = do e <- all_ (_employees employeeDbSettings) + do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Text, QExpr Expression s Int ) + hireDates = do e <- all_ (_employees employeeDbSettings) pure (_employeeFirstName e, _employeeLastName e, _employeeAge e) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) @@ -974,7 +977,8 @@ unionWithGuards = testCase "UNION with guards" $ - do let hireDates = do e <- all_ (_employees employeeDbSettings) + do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) ) + hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e))