diff --git a/IHP/Controller/FileUpload.hs b/IHP/Controller/FileUpload.hs index c1765ecfd..11479a23d 100644 --- a/IHP/Controller/FileUpload.hs +++ b/IHP/Controller/FileUpload.hs @@ -144,10 +144,26 @@ uploadImageFile ext _ user = -- | Saves an uploaded png file. No validation or transformation applied. -- See 'uploadImageFile' for details. -uploadPng :: _ => Proxy fieldName -> record -> IO record +uploadPng :: + ( ?controllerContext::context + , ?requestContext::RequestContext + , SetField fieldName record (Maybe Text) + , HasField "id" record (ModelSupport.Id' (GetTableName (ModelSupport.GetModelByTableName (GetTableName record)))) + , Show (ModelSupport.PrimaryKey (GetTableName (ModelSupport.GetModelByTableName (GetTableName record)))) + , KnownSymbol fieldName + , KnownSymbol (GetTableName record) + ) => Proxy fieldName -> record -> IO record uploadPng field record = uploadImageFile "png" field record -- | Saves an uploaded svg file. No validation or transformation applied. -- See 'uploadImageFile' for details. -uploadSVG :: _ => Proxy fieldName -> record -> IO record +uploadSVG :: + ( ?controllerContext::context + , ?requestContext::RequestContext + , SetField fieldName record (Maybe Text) + , HasField "id" record (ModelSupport.Id' (GetTableName (ModelSupport.GetModelByTableName (GetTableName record)))) + , Show (ModelSupport.PrimaryKey (GetTableName (ModelSupport.GetModelByTableName (GetTableName record)))) + , KnownSymbol fieldName + , KnownSymbol (GetTableName record) + ) => Proxy fieldName -> record -> IO record uploadSVG = uploadImageFile "svg" diff --git a/IHP/ErrorController.hs b/IHP/ErrorController.hs index 5481ca8d7..8b32394c8 100644 --- a/IHP/ErrorController.hs +++ b/IHP/ErrorController.hs @@ -245,7 +245,7 @@ recordNotFoundExceptionHandler exception controller additionalInfo = do respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage)) Nothing -> Nothing -renderError :: _ +renderError :: H.Html -> H.Html -> H.Html renderError errorTitle view = H.docTypeHtml ! A.lang "en" $ [hsx| diff --git a/IHP/IDE/SchemaDesigner/Compiler.hs b/IHP/IDE/SchemaDesigner/Compiler.hs index b97c65cf4..95cbd714c 100644 --- a/IHP/IDE/SchemaDesigner/Compiler.hs +++ b/IHP/IDE/SchemaDesigner/Compiler.hs @@ -103,7 +103,7 @@ compilePostgresType PJSONB = "JSONB" compilePostgresType (PArray type_) = compilePostgresType type_ <> "[]" compilePostgresType (PCustomType theType) = theType -compileIdentifier :: _ -> Text +compileIdentifier :: Text -> Text compileIdentifier identifier = if identifierNeedsQuoting then tshow identifier else identifier where identifierNeedsQuoting = isKeyword || containsSpace diff --git a/IHP/IDE/SchemaDesigner/Controller/Schema.hs b/IHP/IDE/SchemaDesigner/Controller/Schema.hs index 05cdb8f22..d6f8918f7 100644 --- a/IHP/IDE/SchemaDesigner/Controller/Schema.hs +++ b/IHP/IDE/SchemaDesigner/Controller/Schema.hs @@ -64,17 +64,27 @@ instance Controller SchemaController where let generatedHaskellCode = SchemaCompiler.compileStatementPreview statements statement render GeneratedCodeView { .. } -readSchema :: _ => _ +readSchema :: + ( ?controllerContext::ControllerContext + , ?modelContext::ModelContext + , ?requestContext::RequestContext + , ?theAction::controller + ) => IO [Statement] readSchema = parseSchemaSql >>= \case Left error -> do render ErrorView { error }; pure [] Right statements -> pure statements -getSqlError :: _ => IO (Maybe ByteString) +getSqlError :: IO (Maybe ByteString) getSqlError = parseSchemaSql >>= \case Left error -> do pure (Just error) Right statements -> do pure Nothing -updateSchema :: _ => _ +updateSchema :: + ( ?controllerContext :: ControllerContext + , ?modelContext::ModelContext + , ?requestContext::RequestContext + , ?theAction::controller + ) => ([Statement] -> [Statement]) -> IO () updateSchema updateFn = do statements <- readSchema let statements' = updateFn statements diff --git a/IHP/Server.hs b/IHP/Server.hs index a2d33cfec..abc324652 100644 --- a/IHP/Server.hs +++ b/IHP/Server.hs @@ -22,6 +22,7 @@ import IHP.FrameworkConfig (FrameworkConfig, appDatabaseUrl) import IHP.RouterSupport (frontControllerToWAIApp, HasPath, CanRoute, FrontController) import qualified IHP.ErrorController as ErrorController +import qualified IHP.Controller.RequestContext as RequestContext import qualified Network.WebSockets as Websocket import qualified Network.Wai.Handler.WebSockets as Websocket import qualified Control.Concurrent as Concurrent @@ -72,7 +73,7 @@ ihpWebsocketMiddleware (next :: Application) (request :: Request) respond = do (websocketServer request respond) next) request respond -websocketServer :: (?applicationContext :: ApplicationContext) => Request -> _ -> Websocket.ServerApp +websocketServer :: (?applicationContext :: ApplicationContext) => Request -> RequestContext.Respond -> Websocket.ServerApp websocketServer request respond pendingConnection = do requestContext <- ControllerSupport.createRequestContext ?applicationContext request respond let ?requestContext = requestContext