Merge pull request #1782 from digitallyinduced/ghc-warnings

Fix all GHC warnings

.ghci

@@ -42,5 +42,6 @@
 :set -XOverloadedRecordDot
 :set -Werror=missing-fields
 :set -fwarn-incomplete-patterns
+:set -Wno-ambiguous-fields
 :set -O0
 :set -j

IHP/AuthSupport/Controller/Sessions.hs

@@ -128,7 +128,7 @@ currentUserOrNothing =
 {-# INLINE currentUserOrNothing #-}
 
 -- | Returns the NewSessionAction action for the given SessionsController
-buildNewSessionAction :: forall controller action. (?theAction :: controller, Data controller) => controller
+buildNewSessionAction :: forall controller. (?theAction :: controller, Data controller) => controller
 buildNewSessionAction = fromConstr createConstructor
     where
         createConstructor :: Constr

IHP/DataSync/Controller.hs

@@ -2,35 +2,11 @@
 module IHP.DataSync.Controller where
 
 import IHP.ControllerPrelude hiding (OrderByClause)
-import qualified Control.Exception as Exception
-import qualified IHP.Log as Log
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Encoding.Internal as Aeson
 
-import Data.Aeson.TH
-import Data.Aeson
-import qualified Database.PostgreSQL.Simple as PG
-import qualified Database.PostgreSQL.Simple.ToField as PG
-import qualified Database.PostgreSQL.Simple.Types as PG
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.UUID.V4 as UUID
-import qualified Control.Concurrent.MVar as MVar
 import IHP.DataSync.Types
 import IHP.DataSync.RowLevelSecurity
-import IHP.DataSync.DynamicQuery
-import IHP.DataSync.DynamicQueryCompiler
+import qualified Database.PostgreSQL.Simple.ToField as PG
 import qualified IHP.DataSync.ChangeNotifications as ChangeNotifications
-import IHP.DataSync.REST.Controller (aesonValueToPostgresValue)
-import qualified Data.ByteString.Char8 as ByteString
-import qualified Data.ByteString.Builder as ByteString
-import qualified IHP.PGListener as PGListener
-import IHP.ApplicationContext
-import Data.Set (Set)
-import qualified Data.Set as Set
-import qualified Data.Pool as Pool
-
-import qualified Data.Attoparsec.Text as Attoparsec
-import qualified Network.WebSockets as WS
 import IHP.DataSync.ControllerImpl (runDataSyncController, cleanupAllSubscriptions)
 
 instance (

IHP/DataSync/ControllerImpl.hs

@@ -30,6 +30,11 @@ import qualified Data.Pool as Pool
 $(deriveFromJSON defaultOptions ''DataSyncMessage)
 $(deriveToJSON defaultOptions 'DataSyncResult)
 
+type EnsureRLSEnabledFn = Text -> IO TableWithRLS
+type InstallTableChangeTriggerFn = TableWithRLS -> IO ()
+type SendJSONFn = DataSyncResponse -> IO ()
+type HandleCustomMessageFn = (DataSyncResponse -> IO ()) -> DataSyncMessage -> IO ()
+
 runDataSyncController ::
     ( HasField "id" CurrentUserRecord (Id' (GetTableName CurrentUserRecord))
     , ?applicationContext :: ApplicationContext
@@ -40,7 +45,7 @@ runDataSyncController ::
     , Typeable CurrentUserRecord
     , HasNewSessionUrl CurrentUserRecord
     , Show (PrimaryKey (GetTableName CurrentUserRecord))
-    ) => _ -> _ -> _ -> _ -> _ -> IO ()
+    ) => EnsureRLSEnabledFn -> InstallTableChangeTriggerFn -> IO ByteString -> SendJSONFn -> HandleCustomMessageFn -> IO ()
 runDataSyncController ensureRLSEnabled installTableChangeTriggers receiveData sendJSON handleCustomMessage = do
         setState DataSyncReady { subscriptions = HashMap.empty, transactions = HashMap.empty, asyncs = [] }
 
@@ -86,7 +91,7 @@ buildMessageHandler ::
     , HasNewSessionUrl CurrentUserRecord
     , Show (PrimaryKey (GetTableName CurrentUserRecord))
     )
-    => _ -> _ -> _ -> _ -> (DataSyncMessage -> IO ())
+    => EnsureRLSEnabledFn -> InstallTableChangeTriggerFn -> SendJSONFn -> HandleCustomMessageFn -> (DataSyncMessage -> IO ())
 buildMessageHandler ensureRLSEnabled installTableChangeTriggers sendJSON handleCustomMessage = handleMessage
     where
             pgListener = ?applicationContext.pgListener
@@ -366,7 +371,7 @@ buildMessageHandler ensureRLSEnabled installTableChangeTriggers sendJSON handleC
 
             handleMessage otherwise = handleCustomMessage sendJSON otherwise
 
-cleanupAllSubscriptions :: _ => (?state :: IORef DataSyncController, ?applicationContext :: ApplicationContext) => IO ()
+cleanupAllSubscriptions :: (?state :: IORef DataSyncController, ?applicationContext :: ApplicationContext) => IO ()
 cleanupAllSubscriptions = do
     state <- getState
     let pgListener = ?applicationContext.pgListener
@@ -380,7 +385,7 @@ changesToValue changes = object (map changeToPair changes)
     where
         changeToPair ChangeNotifications.Change { col, new } = (Aeson.fromText $ columnNameToFieldName col) .= new
 
-runInModelContextWithTransaction :: (?state :: IORef DataSyncController, _) => ((?modelContext :: ModelContext) => IO result) -> Maybe UUID -> IO result
+runInModelContextWithTransaction :: (?state :: IORef DataSyncController, ?modelContext :: ModelContext) => ((?modelContext :: ModelContext) => IO result) -> Maybe UUID -> IO result
 runInModelContextWithTransaction function (Just transactionId) = do
     let globalModelContext = ?modelContext
 
@@ -419,12 +424,12 @@ ensureBelowSubscriptionsLimit = do
     when (subscriptionsCount >= maxSubscriptionsPerConnection) do
         error ("You've reached the subscriptions limit of " <> tshow maxSubscriptionsPerConnection <> " subscriptions")
 
-maxTransactionsPerConnection :: _ => Int
+maxTransactionsPerConnection :: (?context :: ControllerContext) => Int
 maxTransactionsPerConnection = 
     case getAppConfig @DataSyncMaxTransactionsPerConnection of
         DataSyncMaxTransactionsPerConnection value -> value
 
-maxSubscriptionsPerConnection :: _ => Int
+maxSubscriptionsPerConnection :: (?context :: ControllerContext) => Int
 maxSubscriptionsPerConnection = 
     case getAppConfig @DataSyncMaxSubscriptionsPerConnection of
         DataSyncMaxSubscriptionsPerConnection value -> value

IHP/DataSync/Role.hs

@@ -16,12 +16,8 @@ our second role for the duration of the transaction.
 module IHP.DataSync.Role where
 
 import IHP.Prelude
-import Data.Aeson
-import IHP.QueryBuilder
-import IHP.DataSync.DynamicQuery
 import IHP.FrameworkConfig
 import IHP.ModelSupport
-import qualified Database.PostgreSQL.Simple as PG
 import qualified Database.PostgreSQL.Simple.Types as PG
 
 doesRoleExists :: (?modelContext :: ModelContext) => Text -> IO Bool

IHP/DataSync/RowLevelSecurity.hs

@@ -14,10 +14,6 @@ import qualified Database.PostgreSQL.Simple.ToField as PG
 import qualified Database.PostgreSQL.Simple.Types as PG
 import qualified Database.PostgreSQL.Simple.ToRow as PG
 import qualified IHP.DataSync.Role as Role
-
-import Network.HTTP.Types (status400)
-
-import Data.Set (Set)
 import qualified Data.Set as Set
 
 sqlQueryWithRLS ::

IHP/HaskellSupport.hs

@@ -205,7 +205,7 @@ modify _ updateFunction model = let value = Record.getField @name model in setFi
 -- >         |> modifyJust #startedAt (addUTCTime pauseDuration)
 -- >         |> updateRecord
 --
-modifyJust :: forall model name value updateFunction. (KnownSymbol name, Record.HasField name model (Maybe value), SetField name model (Maybe value)) => Proxy name -> (value -> value) -> model -> model
+modifyJust :: forall model name value. (KnownSymbol name, Record.HasField name model (Maybe value), SetField name model (Maybe value)) => Proxy name -> (value -> value) -> model -> model
 modifyJust _ updateFunction model = case Record.getField @name model of
         Just value -> setField @name (Just (updateFunction value)) model
         Nothing -> model

IHP/IDE/CodeGen/MigrationGenerator.hs

@@ -227,7 +227,6 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                         isMatchingCreateColumn AddColumn { column = addColumn } = actualColumns
                                 |> find \case
                                     Column { name } -> name == columnName
-                                    otherwise       -> False
                                 |> maybe False (\c -> (c :: Column) { name = addColumn.name } == addColumn)
                         isMatchingCreateColumn otherwise                          = False
                 applyRenameColumn (statement:rest) = statement:(applyRenameColumn rest)
@@ -252,7 +251,6 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                         (Just dropColumn) = actualColumns
                                 |> find \case
                                     Column { name } -> name == columnName
-                                    otherwise       -> False
 
                         updateConstraint = if dropColumn.isUnique
                             then DropConstraint { tableName, constraintName = tableName <> "_" <> (dropColumn.name) <> "_key" }
@@ -290,7 +288,6 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                         (Just dropColumn) = actualColumns
                                 |> find \case
                                     Column { name } -> name == columnName
-                                    otherwise       -> False
 
                         matchingCreateColumn :: Maybe Statement
                         matchingCreateColumn = find isMatchingCreateColumn statements
@@ -320,7 +317,6 @@ migrateTable StatementCreateTable { unsafeGetCreateTable = targetTable } Stateme
                         (Just dropColumn) = actualColumns
                                 |> find \case
                                     Column { name } -> name == columnName
-                                    otherwise       -> False
 
                         updateConstraint = if dropColumn.notNull
                             then DropNotNull { tableName, columnName = dropColumn.name }

IHP/IDE/SchemaDesigner/View/Layout.hs

@@ -46,16 +46,12 @@ unmigratedChanges = [hsx|
 </div>
 |]
 
-
 migrationStatus :: Html
-migrationStatus = fromMaybe mempty migrationStatusOrNothing
-
-migrationStatusOrNothing :: _ => Maybe _
-migrationStatusOrNothing = if hasPendingMigrations
-        then Just pendingMigrations
+migrationStatus = if hasPendingMigrations
+        then pendingMigrations
         else if databaseNeedsMigration
-            then Just unmigratedChanges
-            else Nothing
+            then unmigratedChanges
+            else mempty
     where
         (DatabaseNeedsMigration databaseNeedsMigration) = fromFrozenContext @DatabaseNeedsMigration
 

IHP/IDE/ToolServer/Layout.hs

@@ -4,8 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Routes ()
 import qualified IHP.Version as Version
-import qualified Text.Blaze.Html5 as H
-import qualified Text.Blaze.Html5.Attributes as A
 import IHP.IDE.ToolServer.Helper.View
 
 toolServerLayout :: Html -> Html

IHP/Job/Dashboard.hs

@@ -328,6 +328,19 @@ instance {-# OVERLAPPABLE #-} (DisplayableJob job, JobsDashboard rest) => JobsDa
             then deleteJob @(job:rest) table (param "id")
             else deleteJob' @rest False
 
+    retryJob table uuid = do
+        let id    :: UUID = param "id"
+            table :: Text = param "tableName"
+            retryJobById table id = sqlExec ("UPDATE ? SET status = 'job_status_retry' WHERE id = ?") (PG.Identifier table, id)
+        retryJobById table id
+        setSuccessMessage (columnNameToFieldLabel table <> " record marked as 'retry'.")
+        redirectTo ListJobsAction
+    retryJob' = do
+        let table = param "tableName"
+
+        if tableName @job == table
+            then retryJob @(job:rest) table (param "id")
+            else retryJob' @rest
 
 extractText = \(Only t) -> t
 getNotIncludedTableNames includedNames = map extractText <$> sqlQuery

IHP/LoginSupport/Helper/Controller.hs

@@ -74,7 +74,7 @@ currentUserId :: forall user userId. (?context :: ControllerContext, HasNewSessi
 currentUserId = currentRoleId @user
 {-# INLINABLE currentUserId #-}
 
-ensureIsUser :: forall user userId. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => IO ()
+ensureIsUser :: forall user. (?context :: ControllerContext, HasNewSessionUrl user, Typeable user, user ~ CurrentUserRecord) => IO ()
 ensureIsUser = ensureIsRole @user
 {-# INLINABLE ensureIsUser #-}
 
@@ -90,7 +90,7 @@ currentAdminId :: forall admin adminId. (?context :: ControllerContext, HasNewSe
 currentAdminId = currentRoleId @admin
 {-# INLINABLE currentAdminId #-}
 
-ensureIsAdmin :: forall (admin :: Type) adminId. (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin, admin ~ CurrentAdminRecord) => IO ()
+ensureIsAdmin :: forall (admin :: Type). (?context :: ControllerContext, HasNewSessionUrl admin, Typeable admin, admin ~ CurrentAdminRecord) => IO ()
 ensureIsAdmin = ensureIsRole @admin
 {-# INLINABLE ensureIsAdmin #-}
 

IHP/RouterSupport.hs

@@ -118,8 +118,7 @@ toRouteParseResult ioResponseReceived = pure (\t -> t, \_ -> ioResponseReceived)
 
 class FrontController application where
     controllers
-        :: forall controller
-         . (?applicationContext :: ApplicationContext, ?application :: application, ?context :: RequestContext)
+        :: (?applicationContext :: ApplicationContext, ?application :: application, ?context :: RequestContext)
         => [RouteParser]
 
     router
@@ -326,7 +325,7 @@ applyConstr parseIdType constructor query = let
     attemptToParseArg queryParam@(queryName, queryValue) [] = State.lift (Left NoConstructorMatched
                 { field = queryName
                 , value = queryValue
-                , expectedType = (dataTypeOf (undefined :: d)) |> dataTypeName |> cs
+                , expectedType = (dataTypeOf (Prelude.undefined :: d)) |> dataTypeName |> cs
                 })
     attemptToParseArg queryParam@(k, v) (parseFunc:restFuncs) = case parseFunc v of
             Right result -> pure result
@@ -750,7 +749,7 @@ onlyAllowMethods methods = do
 --
 -- The request @\/AutoRefreshWSApp@ will call the AutoRefreshWSApp
 --
-webSocketApp :: forall webSocketApp application controller.
+webSocketApp :: forall webSocketApp application.
     ( WSApp webSocketApp
     , InitControllerContext application
     , ?application :: application
@@ -796,7 +795,7 @@ webSocketAppWithHTTPFallback = webSocketAppWithCustomPathAndHTTPFallback @webSoc
 --
 -- The request @\/my-ws-app@ will call the AutoRefreshWSApp
 --
-webSocketAppWithCustomPath :: forall webSocketApp application controller.
+webSocketAppWithCustomPath :: forall webSocketApp application.
     ( WSApp webSocketApp
     , InitControllerContext application
     , ?application :: application
@@ -829,7 +828,7 @@ webSocketAppWithCustomPathAndHTTPFallback path = toRouteParser do
 
 
 -- | Defines the start page for a router (when @\/@ is requested).
-startPage :: forall action application controller. (Controller action, InitControllerContext application, ?application::application, ?applicationContext::ApplicationContext, ?context::RequestContext, Typeable application, Typeable action) => action -> RouteParser
+startPage :: forall action application. (Controller action, InitControllerContext application, ?application::application, ?applicationContext::ApplicationContext, ?context::RequestContext, Typeable application, Typeable action) => action -> RouteParser
 startPage action = get (ByteString.pack (actionPrefix @action)) action
 {-# INLINABLE startPage #-}
 

IHP/Server.hs

@@ -153,7 +153,7 @@ runServer FrameworkConfig { environment = Env.Production, appPort, exceptionTrac
 instance ControllerSupport.InitControllerContext () where
     initContext = pure ()
 
-withInitalizers :: FrameworkConfig -> ModelContext -> _ -> IO ()
+withInitalizers :: FrameworkConfig -> ModelContext -> IO () -> IO ()
 withInitalizers frameworkConfig modelContext continue = do
         let ?context = frameworkConfig
         let ?modelContext = modelContext

IHP/ServerSideComponent/ControllerFunctions.hs

@@ -42,7 +42,7 @@ setState state = do
         Right patches -> sendTextData (Aeson.encode patches)
 
 
-getState :: _ => _
+getState :: (?instanceRef :: IORef (ComponentInstance state)) => IO state
 getState = (.state) <$> readIORef ?instanceRef
 
 deriveSSC = Aeson.deriveJSON Aeson.defaultOptions { allNullaryToStringTag = False, sumEncoding = defaultTaggedObject { tagFieldName = "action", contentsFieldName = "payload" }}

IHP/ServerSideComponent/HtmlDiff.hs

@@ -8,6 +8,8 @@ module IHP.ServerSideComponent.HtmlDiff where
 import IHP.Prelude
 import IHP.ServerSideComponent.HtmlParser
 import qualified Data.Text as Text
+import Text.Megaparsec.Error (ParseErrorBundle)
+import Data.Void (Void)
 
 data NodeOperation
     = UpdateTextContent { textContent :: !Text, path :: ![Int] }
@@ -25,7 +27,7 @@ data AttributeOperation
     | DeleteAttribute { attributeName :: !Text }
     deriving (Eq, Show)
 
-diffHtml :: Text -> Text -> Either _ [NodeOperation]
+diffHtml :: Text -> Text -> Either (ParseErrorBundle Text Void) [NodeOperation]
 diffHtml a b = do
     nodeA <- parseHtml a
     nodeB <- parseHtml b

IHP/Test/Mocking.hs

@@ -154,7 +154,7 @@ callJob job = do
 
 
 -- | mockAction has been renamed to callAction
-mockAction :: _ => _
+mockAction :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> IO Response
 mockAction = callAction
 
 -- | Get contents of response

IHP/ValidationSupport/ValidateCanView.hs

@@ -7,7 +7,7 @@ import IHP.Fetch (Fetchable, fetchOneOrNothing)
 import IHP.ModelSupport (Table)
 import IHP.ValidationSupport.Types
 
-validateCanView :: forall field user model validationState fieldValue fetchedModel. (
+validateCanView :: forall field user model fieldValue fetchedModel. (
         ?model :: model
         , ?modelContext :: ModelContext
         , PG.FromRow fetchedModel

Paths_ihp.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-deprecations  #-}
 module Paths_ihp where
 
 import Data.Version

exe/IHP/CLI/NewMigration.hs

@@ -1,7 +1,6 @@
 module Main where
 
 import IHP.Prelude
-import IHP.SchemaMigration
 import qualified System.Posix.Env.ByteString as Posix
 import qualified System.Directory as Directory
 import IHP.IDE.ToolServer.Helper.Controller (openEditor)