From 103fe2a4c07fe47628e6165c1acc429c0f6f5a09 Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Sun, 30 Jul 2023 13:42:18 +0200 Subject: [PATCH 1/5] Disable verbose GHC warnings - redundant constraints are often false positives that we cannot fix - the amigious fields warning is not relevant for now --- ihp.cabal | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/ihp.cabal b/ihp.cabal index d70cc545a..fefe4fdb8 100644 --- a/ihp.cabal +++ b/ihp.cabal @@ -146,13 +146,13 @@ common shared-properties -threaded +RTS -A256m -n4m -H512m -qg -N -RTS - -Wredundant-constraints -Wunused-imports -Wunused-foralls -Wmissing-fields -Winaccessible-code -Wmissed-specialisations -Wall-missed-specialisations + -Wno-ambiguous-fields else ghc-options: -fstatic-argument-transformation @@ -161,7 +161,6 @@ common shared-properties -O1 -threaded - -Wredundant-constraints -Wunused-imports -Wunused-foralls -Wmissing-fields @@ -169,6 +168,7 @@ common shared-properties -Wmissed-specialisations -Wall-missed-specialisations -fexpose-all-unfoldings + -Wno-ambiguous-fields library import: shared-properties @@ -392,6 +392,7 @@ executable RunDevServer -O0 -threaded +RTS -A512m -n4m -H512m -G3 -qg -N -RTS + -Wno-ambiguous-fields else ghc-options: -fconstraint-solver-iterations=100 @@ -413,6 +414,7 @@ executable RunDevServer -with-rtsopts=-n4m -with-rtsopts=--nonmoving-gc +RTS -A256m -n4m -H512m -G3 -qg -N -RTS + -Wno-ambiguous-fields executable new-application import: shared-properties From 39d49d564f675a2ad3b2f412e7ad66467364bf14 Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Sun, 30 Jul 2023 14:33:18 +0200 Subject: [PATCH 2/5] Fixed deprecation warning from Paths_ihp --- Paths_ihp.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Paths_ihp.hs b/Paths_ihp.hs index 5a3348f1c..eee6e56d2 100644 --- a/Paths_ihp.hs +++ b/Paths_ihp.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} module Paths_ihp where import Data.Version From 6c5d26b5c52c383c287ec50dde1beaeac2c8bc46 Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Sun, 30 Jul 2023 14:33:39 +0200 Subject: [PATCH 3/5] Fixed missing retryJob implementation in IHP.Job.Dashboard --- IHP/Job/Dashboard.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/IHP/Job/Dashboard.hs b/IHP/Job/Dashboard.hs index a59e5b32e..9c6694f6e 100644 --- a/IHP/Job/Dashboard.hs +++ b/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 From 81d58f8acb14929b2f07f13ac6d1c6850a13648c Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Sun, 30 Jul 2023 14:34:00 +0200 Subject: [PATCH 4/5] Disabled ambiguous-fields warnings when loading IHP into ghci --- .ghci | 1 + 1 file changed, 1 insertion(+) diff --git a/.ghci b/.ghci index 2f006cc43..0c4872683 100644 --- a/.ghci +++ b/.ghci @@ -42,5 +42,6 @@ :set -XOverloadedRecordDot :set -Werror=missing-fields :set -fwarn-incomplete-patterns +:set -Wno-ambiguous-fields :set -O0 :set -j \ No newline at end of file From 39ef0d825b3cd0cb7bd5c8858dba5b56ccb2124e Mon Sep 17 00:00:00 2001 From: Marc Scholten Date: Sun, 30 Jul 2023 14:35:11 +0200 Subject: [PATCH 5/5] Fixed other minor GHC warnings --- IHP/AuthSupport/Controller/Sessions.hs | 2 +- IHP/DataSync/Controller.hs | 26 +------------------ IHP/DataSync/ControllerImpl.hs | 17 +++++++----- IHP/DataSync/Role.hs | 4 --- IHP/DataSync/RowLevelSecurity.hs | 4 --- IHP/HaskellSupport.hs | 2 +- IHP/IDE/CodeGen/MigrationGenerator.hs | 4 --- IHP/IDE/SchemaDesigner/View/Layout.hs | 12 +++------ IHP/IDE/ToolServer/Layout.hs | 2 -- IHP/LoginSupport/Helper/Controller.hs | 4 +-- IHP/RouterSupport.hs | 11 ++++---- IHP/Server.hs | 2 +- .../ControllerFunctions.hs | 2 +- IHP/ServerSideComponent/HtmlDiff.hs | 4 ++- IHP/Test/Mocking.hs | 2 +- IHP/ValidationSupport/ValidateCanView.hs | 2 +- exe/IHP/CLI/NewMigration.hs | 1 - 17 files changed, 32 insertions(+), 69 deletions(-) diff --git a/IHP/AuthSupport/Controller/Sessions.hs b/IHP/AuthSupport/Controller/Sessions.hs index 1da1339aa..c3c2cda74 100644 --- a/IHP/AuthSupport/Controller/Sessions.hs +++ b/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 diff --git a/IHP/DataSync/Controller.hs b/IHP/DataSync/Controller.hs index 6a3b9d2f9..6cd6daeff 100644 --- a/IHP/DataSync/Controller.hs +++ b/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 ( diff --git a/IHP/DataSync/ControllerImpl.hs b/IHP/DataSync/ControllerImpl.hs index 82ce20255..431953432 100644 --- a/IHP/DataSync/ControllerImpl.hs +++ b/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 diff --git a/IHP/DataSync/Role.hs b/IHP/DataSync/Role.hs index 5856a3044..5655105a1 100644 --- a/IHP/DataSync/Role.hs +++ b/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 diff --git a/IHP/DataSync/RowLevelSecurity.hs b/IHP/DataSync/RowLevelSecurity.hs index bd8a745e2..d26d63612 100644 --- a/IHP/DataSync/RowLevelSecurity.hs +++ b/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 :: diff --git a/IHP/HaskellSupport.hs b/IHP/HaskellSupport.hs index 9175594cc..92f18cdfc 100644 --- a/IHP/HaskellSupport.hs +++ b/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 diff --git a/IHP/IDE/CodeGen/MigrationGenerator.hs b/IHP/IDE/CodeGen/MigrationGenerator.hs index 3ab4e2b64..8cec75b7b 100644 --- a/IHP/IDE/CodeGen/MigrationGenerator.hs +++ b/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 } diff --git a/IHP/IDE/SchemaDesigner/View/Layout.hs b/IHP/IDE/SchemaDesigner/View/Layout.hs index 4025aeced..c19f89215 100644 --- a/IHP/IDE/SchemaDesigner/View/Layout.hs +++ b/IHP/IDE/SchemaDesigner/View/Layout.hs @@ -46,16 +46,12 @@ unmigratedChanges = [hsx| |] - 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 diff --git a/IHP/IDE/ToolServer/Layout.hs b/IHP/IDE/ToolServer/Layout.hs index 62f43ee26..ed477eed3 100644 --- a/IHP/IDE/ToolServer/Layout.hs +++ b/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 diff --git a/IHP/LoginSupport/Helper/Controller.hs b/IHP/LoginSupport/Helper/Controller.hs index fec791c03..c3e0242d3 100644 --- a/IHP/LoginSupport/Helper/Controller.hs +++ b/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 #-} diff --git a/IHP/RouterSupport.hs b/IHP/RouterSupport.hs index 4b620d856..0a35bc64a 100644 --- a/IHP/RouterSupport.hs +++ b/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 #-} diff --git a/IHP/Server.hs b/IHP/Server.hs index 290c58060..8f25c34e5 100644 --- a/IHP/Server.hs +++ b/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 diff --git a/IHP/ServerSideComponent/ControllerFunctions.hs b/IHP/ServerSideComponent/ControllerFunctions.hs index fa2ec6323..b59f92f8d 100644 --- a/IHP/ServerSideComponent/ControllerFunctions.hs +++ b/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" }} diff --git a/IHP/ServerSideComponent/HtmlDiff.hs b/IHP/ServerSideComponent/HtmlDiff.hs index 674445e2d..7fd846245 100644 --- a/IHP/ServerSideComponent/HtmlDiff.hs +++ b/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 diff --git a/IHP/Test/Mocking.hs b/IHP/Test/Mocking.hs index 7b513faee..0598b2abd 100644 --- a/IHP/Test/Mocking.hs +++ 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 diff --git a/IHP/ValidationSupport/ValidateCanView.hs b/IHP/ValidationSupport/ValidateCanView.hs index fc5fc2852..696155636 100644 --- a/IHP/ValidationSupport/ValidateCanView.hs +++ b/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 diff --git a/exe/IHP/CLI/NewMigration.hs b/exe/IHP/CLI/NewMigration.hs index ce9944660..88266d5d6 100644 --- a/exe/IHP/CLI/NewMigration.hs +++ b/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)