Fix werror messages and get CI to pass

haskell-beam · Dec 11, 2018 · 377596e · 377596e
1 parent 730d6bc
commit 377596e
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 13 deletions.
diff --git a/beam-core/test/Database/Beam/Test/SQL.hs b/beam-core/test/Database/Beam/Test/SQL.hs
@@ -59,7 +59,7 @@ selectMock = select
 
 updateMock :: Beamable table
            => DatabaseEntity (MockSqlBackend Command) db (TableEntity table)
-           -> (forall s. table (QField s) -> [ QAssignment (MockSqlBackend Command) s ])
+           -> (forall s. table (QField s) -> QAssignment (MockSqlBackend Command) s)
            -> (forall s. table (QExpr (MockSqlBackend Command) s) -> QExpr (MockSqlBackend Command) s Bool)
            -> SqlUpdate (MockSqlBackend Command) table
 updateMock = update
@@ -1137,9 +1137,9 @@ existsTest =
 updateCurrent :: TestTree
 updateCurrent =
   testCase "UPDATE can use current value" $
-  do SqlUpdate Update { .. } <-
+  do SqlUpdate _ (Update { .. }) <-
        pure $ updateMock (_employees employeeDbSettings)
-                         (\employee -> [ _employeeAge employee <-. current_ (_employeeAge employee) + 1])
+                         (\employee -> _employeeAge employee <-. current_ (_employeeAge employee) + 1)
                          (\employee -> _employeeFirstName employee ==. "Joe")
 
      updateTable @?= (TableName Nothing "employees")
@@ -1154,9 +1154,9 @@ updateNullable =
      let employeeKey :: PrimaryKey EmployeeT (Nullable Identity)
          employeeKey = EmployeeId (Just "John") (Just "Smith") (Just curTime)
 
-     SqlUpdate Update { .. } <-
+     SqlUpdate _ (Update { .. }) <-
        pure $ updateMock (_departments employeeDbSettings)
-                         (\department -> [ _departmentHead department <-. val_ employeeKey ])
+                         (\department -> _departmentHead department <-. val_ employeeKey)
                          (\department -> _departmentName department ==. "Sales")
 
      updateTable @?= (TableName Nothing "departments")

diff --git a/beam-migrate/Database/Beam/Migrate/Actions.hs b/beam-migrate/Database/Beam/Migrate/Actions.hs
@@ -371,7 +371,7 @@ addColumnProvider =
       do colP@(TableHasColumn tblNm colNm colType :: TableHasColumn be)
            <- findPostConditions
          TableExistsPredicate tblNm' <- findPreConditions
-         guard (tblNm' == tblNm && dataTypeHasBeenCreated colType findPreConditions)
+         guard (tblNm'  == tblNm && dataTypeHasBeenCreated colType findPreConditions)
          ensuringNot_ $ do
            TableHasColumn tblNm'' colNm' _ :: TableHasColumn be <-
              findPreConditions
@@ -380,10 +380,10 @@ addColumnProvider =
          (constraintsP, constraints) <-
            pure . unzip $ do
            constraintP@
-             (TableColumnHasConstraint tblNm' colNm' c
+             (TableColumnHasConstraint tblNm'' colNm' c
               :: TableColumnHasConstraint be) <-
              findPostConditions
-           guard (tblNm == tblNm')
+           guard (tblNm == tblNm'')
            guard (colNm == colNm')
 
            pure (p constraintP, c)

diff --git a/beam-postgres/Database/Beam/Postgres/Migrate.hs b/beam-postgres/Database/Beam/Postgres/Migrate.hs
@@ -311,7 +311,7 @@ pgEnumerationTypeFromAtt :: [ (T.Text, Pg.Oid, V.Vector T.Text) ] -> ByteString
 pgEnumerationTypeFromAtt enumData =
   let enumDataMap = HM.fromList [ (fromIntegral oid' :: Word64, -- Get around lack of Hashable for CUInt
                                    PgDataTypeSyntax (PgDataTypeDescrDomain nm) (emit (TE.encodeUtf8 nm))
-                                          (pgDataTypeJSON (object [ "customType" .= nm ]))) | (nm, oid@(Pg.Oid oid'), _) <- enumData ]
+                                          (pgDataTypeJSON (object [ "customType" .= nm ]))) | (nm, (Pg.Oid oid'), _) <- enumData ]
   in \_ (Pg.Oid oid) _ -> HM.lookup (fromIntegral oid) enumDataMap
 
 pgUnknownDataType :: Pg.Oid -> Maybe Int32 -> PgDataTypeSyntax

diff --git a/beam-postgres/Database/Beam/Postgres/Syntax.hs b/beam-postgres/Database/Beam/Postgres/Syntax.hs
@@ -1,7 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-name-shadowing #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -89,7 +88,6 @@ import           Database.Beam hiding (insert)
 import           Database.Beam.Backend.SQL
 import           Database.Beam.Migrate
 import           Database.Beam.Migrate.Checks (HasDataTypeCreatedCheck(..))
-import           Database.Beam.Migrate.SQL
 import           Database.Beam.Migrate.SQL.Builder hiding (fromSqlConstraintAttributes)
 import           Database.Beam.Migrate.Serialization
 
@@ -675,10 +673,13 @@ mkNumericPrec (Just (whole, dec)) = Just $ (fromIntegral whole `shiftL` 16) .|.
 instance IsCustomSqlSyntax PgExpressionSyntax where
   newtype CustomSqlSyntax PgExpressionSyntax =
     PgCustomExpressionSyntax { fromPgCustomExpression :: PgSyntax }
-    deriving (Monoid, Semigroup)
+    deriving Monoid
   customExprSyntax = PgExpressionSyntax . fromPgCustomExpression
   renderSyntax = PgCustomExpressionSyntax . pgParens . fromPgExpression
 
+instance Semigroup (CustomSqlSyntax PgExpressionSyntax) where
+  (<>) = mappend
+
 instance IsString (CustomSqlSyntax PgExpressionSyntax) where
   fromString = PgCustomExpressionSyntax . emit . fromString
 
@@ -1147,7 +1148,8 @@ defaultPgValueSyntax =
 -- Database Predicates
 
 data PgHasEnum = PgHasEnum T.Text {- Enumeration name -} [T.Text] {- enum values -}
-    deriving (Show, Eq, Generic, Hashable)
+    deriving (Show, Eq, Generic)
+instance Hashable PgHasEnum
 instance DatabasePredicate PgHasEnum where
     englishDescription (PgHasEnum enumName values) =
         "Has postgres enumeration " ++ show enumName ++ " with values " ++ show values