Fixed most build warnings

Fix #512
digitallyinduced · Oct 30, 2020 · d2ffe14 · d2ffe14
1 parent 4762a03
commit d2ffe14
Show file tree

Hide file tree

Showing 5 changed files with 35 additions and 8 deletions.
diff --git 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
@@ -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|
 <head>
     <meta charset="utf-8"/>

diff --git 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
@@ -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
@@ -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