Unable to unify types, out of ideas SOLVED

Help
, ,
#1

Hello all, (solution)

I have purescript module that I’m out of ideas why it is not working, problem is function

executeWithConnection :: Either String Form -> Either PGError Connection -> Aff (Either String (Maybe PGError))
executeWithConnection eitherBodyParams eitherConn = do
  input <- prepareValues eitherConn eitherBodyParams
  pure $ executeQueries input

problem I get is

Error found:
in module Main
at src/Main.purs:115:3 - 115:53 (line 115, column 3 - line 115, column 53)

  Could not match type
                 
    Either String
                 
  with type
       
    Aff
       

while trying to match type Either String t0
  with type Aff (Either String (Maybe PGError))
while checking that expression (bind ((prepareValues eitherConn) eitherBodyParams)) (\input ->                            
                                                                                       (apply pure) (executeQueries input)
                                                                                    )                                     
  has type Aff (Either String (Maybe PGError))
in value declaration executeWithConnection

where t0 is an unknown type

See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,
or to contribute content related to this error.

I was triing add/remove pure in function but it did not worked out, whole file is like this

module Main where

import Prelude (Unit, (==), ($), bind, show, pure, discard, (<>), flip)

import Control.Monad.Indexed.Qualified as Ix
import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Control.Monad.Reader.Class (class MonadAsk)

import Data.Number as Number
import Data.Maybe (Maybe(Just))
import Data.Either (Either(Right, Left))
import Data.HTTP.Method (Method(GET, POST))
import Data.Bifunctor (rmap, lmap)

import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class.Console (logShow)

import Hyper.Middleware (lift', Middleware)
import Hyper.Node.Server (defaultOptionsWithLogging, runServer', HttpRequest, HttpResponse)
import Hyper.Response (closeHeaders, respond, writeStatus, StatusLineOpen, ResponseEnded)
import Hyper.Request (getRequestData)
import Hyper.Status (Status, statusOK, statusBadRequest)
import Hyper.Form (Form, parseForm, required)
import Hyper.Conn (Conn)

import Text.Smolder.HTML (Html, html, p, form, label, input, button, div)
import Text.Smolder.HTML.Attributes (method, for, id, name, type')
import Text.Smolder.Markup (text, (!))
import Text.Smolder.Renderer.String (render)

import Database.PostgreSQL (Pool, PoolConfiguration, Connection, PGError, newPool, withConnection, execute, defaultPoolConfiguration, Row3(Row3), Query(Query))

type ComponentsType = Record ()
type ConnHttp resp = Conn HttpRequest (HttpResponse resp) ComponentsType

type Env = 
  { pool :: Pool
  }

type AppM m = ReaderT Env m

getPool :: forall m. MonadAsk Env m => m Pool
getPool = asks _.pool

runAppM ∷ forall a. Env -> (AppM Aff a) -> Aff a
runAppM = flip runReaderT

config :: PoolConfiguration
config = 
  let default = defaultPoolConfiguration "purescript" 
  in default 
    { host = Just "localhost"
    , password = Just "postgres"
    , user = Just "postgres" 
    }

send :: Status -> Html Unit ->  Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
send status body = Ix.do
  writeStatus status
  closeHeaders
  respond (render body)

greetTemplate :: String -> Html Unit
greetTemplate name = html (p (text $ "Hello " <> name))

formTemplate :: Html Unit
formTemplate = 
  html do 
    form ! method "post" $ do
      label ! for "name" $ text "Name"
      input ! id "name" ! name "name"
      button $ text "Greet"

fruitForm :: Html Unit
fruitForm =
  html do
    form ! method "post" $ do
      div do
        label ! for "name" $ text "Name"
        input ! id "name" ! name "name"

      div do
        label ! for "delicious" $ text "Delicious"
        input ! id "delicious" ! name "delicious" ! type' "checkbox"
      
      div do
        label ! for "price" $ text "Price"
        input ! id "price" ! name "price" ! type' "number"

      button $ text "Save"
        

errorTemplate :: String -> Html Unit
errorTemplate error = html do
    p (text error)

formHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
formHandler = send statusOK formTemplate

fruitNewHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
fruitNewHandler = send statusOK fruitForm

fruitCreateHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
fruitCreateHandler = Ix.do
  eitherBodyParams <- parseForm
  result <- lift' $ do
    logShow "Staring"
    pool <- getPool
    withConnection pool (executeWithConnection eitherBodyParams)
  badRequestHandler "Success"

executeWithConnection :: Either String Form -> Either PGError Connection -> Aff (Either String (Maybe PGError))
executeWithConnection eitherBodyParams eitherConn = do
  input <- prepareValues eitherConn eitherBodyParams
  pure $ executeQueries input

prepareValues :: (Either PGError Connection) -> (Either String Form) -> Either String {conn :: Connection, name :: String, delicious :: String, price :: String}
prepareValues eitherConn eitherBodyParams = do
  conn <- lmap show eitherConn
  params <- eitherBodyParams
  name <- required "name" params
  delicious <- required "delicious" params
  price <- required "price" params
  pure {conn, name, delicious, price}

executeQueries :: {conn :: Connection, name :: String, delicious :: String, price :: String} -> Aff Unit
executeQueries {conn, name, delicious, price} =
  let 
    query = Query "INSERT INTO fruits (name, delicious, price) VALUE ($1, $2, $3)"
    row = (Row3 name (castBoolean delicious) (Number.fromString price))
  in do
    result <- execute conn query row
    logShow result

castBoolean :: String -> Boolean
castBoolean value = value == "on"

badRequestHandler ::  String -> Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
badRequestHandler message = send statusBadRequest (errorTemplate message)

postHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
postHandler = Ix.do
  bodyData <- parseForm 
  
  case bodyData of
    Right params -> case required "name" params of
      Right name -> send statusOK (greetTemplate name)
      _ -> badRequestHandler "Missing name"
    _ -> badRequestHandler "Invalid Body"

handler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
handler = Ix.do
  requestData <- getRequestData
  case requestData.url of
    "/fruits" ->
      case requestData.method of
        Left GET -> fruitNewHandler
        Left POST -> fruitCreateHandler
        _ -> badRequestHandler "Unsupported method"
    _ ->
      case requestData.method of
        Left GET -> formHandler
        Left POST -> postHandler
        _ -> badRequestHandler "Unsupported method"

main :: Effect Unit
main = do
  pool <- newPool config
  runServer' defaultOptionsWithLogging {} (runAppM { pool: pool }) handler

any ideas? Thank you in advance :slight_smile:

#2

You need to put pure before do in executeWithConnection to wrap the Either in Aff, or preferably make it return an Either directly, as it uses nothing specific to Aff.

1 Like
#3

To use do and <- (aka bind) you have to work in a single monad. In this case you are mixing Either (prepareValues :: _ -> _ -> Either _ _) with Aff (executeQueries :: _ -> Aff _).

You want to probably case over Either and perform your query afterwards. I think something like this should work:

executeWithConnection eitherBodyParams eitherConn = case prepareValues eitherConn eitherBodyParams of
  Right params -> pure executeQueries params
  Left e -> REPORT AN ERROR? (BadRequest or something)
4 Likes
#4

What do you mean that it is not doing nothing specific to Aff? It is calling excute conn query row which returns Aff, so I can’t get rid of it :confused:, thank you for reply.

1 Like
#5

Oops, it slipped through my eyes. In any case, @paluh’s reply is more comprehensive.

1 Like
#6

That version I actualy had there before, one thing is that I would like to buble error from there to fruitCreateHandler to by able to return http error (in context of hyper), second problem is that for some reason

executeQueries :: {conn :: Connection, name :: String, delicious :: String, price :: String} -> Aff Unit
executeQueries {conn, name, delicious, price} =
  let 
    query = Query "INSERT INTO fruits (name, delicious, price) VALUE ($1, $2, $3)"
    row = (Row3 name (castBoolean delicious) (Number.fromString price))
  in do
    execute conn query row >>= logShow -- this logshow

won’t print anything, but by looking into database I see that there should by some error or something…
It build, it run, but don’t do anything :confused:

#7

If you really want to work with Aff and Either together, you’re probably going to want to start using monad transformers. You could bubble the error up manually, like

executeWithConnection eitherBodyParams eitherConn = case prepareValues eitherConn eitherBodyParams of
  Right params -> Right <$> executeQueries params
  Left e -> pure $ Left e

which might be acceptable for small functions like this, but it can get out of hand pretty quickly without using the ExceptT transformer. (I thought the section on monad transformers from the book was really helpful).

Alternatively, you might consider ditching Either in your return type. I thought this blog was a great explanation of the concept. The gist is that Aff already propagates errors by bubbling them up, and it’s absolutely wrong to just “assume” that any Aff will work without errors. As long as you have to catch errors in Aff anyway, might as well put all errors in Aff instead of having Affs and Eithers mixed together, which gives you multiple channels where errors could occur, and means you have to duplicate your error handling.
Now, unlike Haskell, in PureScript you can’t (yet) distinguish multiple types of errors in Aff, they all have to be the Error type, so if you need to actually pattern match on different kinds of errors, this advice doesn’t hold up so well. You’re probably better off with Aff (Either MyCustomErrorType Unit) in that case. Anyway, if you wanted to try the approach of ditching Either, it might look like:

executeWithConnection :: Either String Form -> Either PGError Connection -> Aff Unit
executeWithConnection eitherBodyParams eitherConn = case prepareValues eitherConn eitherBodyParams of
  Right params -> executeQueries params
  Left e -> throwError $ error e

You might even consider using MonadError throughout the code instead of Either String or making a function that’ll do Either String a -> Aff a if you find yourself converting between Either String and Aff often.

1 Like
#8

I’m learning so small steps, lets get working something basic, Aff error and ExceptionT is in mi roadmap but for now I’m triing to make work postgresql and hyper with as close to default return values without transforming, both are heavili depending on Either and Maybe…

#9

Ok, there is some progress with considering @paluh , @ntwilson, I updated some functions

fruitCreateHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
fruitCreateHandler = Ix.do
  eitherBodyParams <- parseForm
  result <- lift' tttt
  logShow result
  badRequestHandler "Success"

tttt :: Either String Form -> AppM Aff (Maybe PGError)
tttt eitherBodyParams =  do
  logShow "Staring"
  pool <- getPool
  withConnection pool (executeWithConnection eitherBodyParams)

executeWithConnection :: Either String Form -> Either PGError Connection -> Aff (Maybe String)
executeWithConnection eitherBodyParams eitherConn = 
  case prepareValues eitherConn eitherBodyParams of
    Right input -> liftResult <$> (executeQueries input)
    Left e -> pure $ Just e
    where
      liftResult :: Maybe PGError -> Maybe String
      liftResult result =
        case result of
          Nothing -> Nothing
          Just e -> Just (show e)

which give mi error

Error found:
in module Main
at src/Main.purs:117:3 - 117:20 (line 117, column 3 - line 117, column 20)

  Could not match type
       
    Aff
       
  with type
                    
    ReaderT         
      { pool :: Pool
      }             
      Aff           
                    

while trying to match type t0 t1
  with type ReaderT          
              { pool :: Pool 
              }              
              Aff            
              (Maybe PGError)
while checking that expression (discard (logShow "Staring")) (\$__unused ->              
                                                                (bind getPool) (\pool -> 
                                                                                  ...    
                                                                               )         
                                                             )                           
  has type ReaderT          
             { pool :: Pool 
             }              
             Aff            
             (Maybe PGError)
in value declaration tttt

where t1 is an unknown type
      t0 is an unknown type

See https://github.com/purescript/documentation/blob/master/errors/TypesDoNotUnify.md for more information,
or to contribute content related to this error.

And that is quite confusing for me since I tried to isolate that error by running function returning Aff in context ReaderT Aff, I even put question there and it is working, but in this case it is not :confused:

#10

I finally managed to solve it :smiley:, problem was that all the experiments with ReaderT in refered code was with logShow but here I tried to use withConnection, difference between theses two is that logShow is returning any MonadEffect while withConnection is returning Aff. But I found that Aff have defined liftAff for ReaderT. So after adding liftAff before with connection it started to work, so finall code for tttt function (I also found meaningfull name for that function:

fruitCreateDomainHandler :: Either String Form -> AppM Aff (Maybe String)
fruitCreateDomainHandler eitherBodyParams = do
  pool <- getPool
  liftAff $ withConnection pool (executeWithConnection eitherBodyParams)

And whole code

module Main where

import Prelude (Unit, (==), ($), (<$>), (<>), bind, show, pure, discard, flip)

import Control.Monad.Indexed.Qualified as Ix
import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Control.Monad.Reader.Class (class MonadAsk)

import Data.Number as Number
import Data.Maybe (Maybe(Just, Nothing))
import Data.Either (Either(Right, Left))
import Data.HTTP.Method (Method(GET, POST))
import Data.Bifunctor (lmap)

import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff.Class (liftAff)
import Effect.Class.Console (logShow)

import Hyper.Middleware (lift', Middleware)
import Hyper.Node.Server (defaultOptionsWithLogging, runServer', HttpRequest, HttpResponse)
import Hyper.Response (closeHeaders, respond, writeStatus, StatusLineOpen, ResponseEnded)
import Hyper.Request (getRequestData)
import Hyper.Status (Status, statusOK, statusBadRequest)
import Hyper.Form (Form, parseForm, required)
import Hyper.Conn (Conn)

import Text.Smolder.HTML (Html, html, p, form, label, input, button, div)
import Text.Smolder.HTML.Attributes (method, for, id, name, type')
import Text.Smolder.Markup (text, (!))
import Text.Smolder.Renderer.String (render)

import Database.PostgreSQL (Pool, PoolConfiguration, Connection, PGError, newPool, withConnection, execute, defaultPoolConfiguration, Row3(Row3), Query(Query))

type ComponentsType = Record ()
type ConnHttp resp = Conn HttpRequest (HttpResponse resp) ComponentsType

type Env = 
  { pool :: Pool
  }

type AppM m = ReaderT Env m

getPool :: forall m. MonadAsk Env m => m Pool
getPool = asks _.pool

runAppM ∷ forall a. Env -> (AppM Aff a) -> Aff a
runAppM = flip runReaderT

config :: PoolConfiguration
config = 
  let default = defaultPoolConfiguration "purescript" 
  in default 
    { host = Just "localhost"
    , password = Just "postgres"
    , user = Just "postgres" 
    }

send :: Status -> Html Unit ->  Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
send status body = Ix.do
  writeStatus status
  closeHeaders
  respond (render body)

greetTemplate :: String -> Html Unit
greetTemplate name = html (p (text $ "Hello " <> name))

formTemplate :: Html Unit
formTemplate = 
  html do 
    form ! method "post" $ do
      label ! for "name" $ text "Name"
      input ! id "name" ! name "name"
      button $ text "Greet"

fruitForm :: Html Unit
fruitForm =
  html do
    form ! method "post" $ do
      div do
        label ! for "name" $ text "Name"
        input ! id "name" ! name "name"

      div do
        label ! for "delicious" $ text "Delicious"
        input ! id "delicious" ! name "delicious" ! type' "checkbox"
      
      div do
        label ! for "price" $ text "Price"
        input ! id "price" ! name "price" ! type' "number"

      button $ text "Save"
        

errorTemplate :: String -> Html Unit
errorTemplate error = html do
    p (text error)

formHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
formHandler = send statusOK formTemplate

fruitNewHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
fruitNewHandler = send statusOK fruitForm

fruitCreateHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
fruitCreateHandler = Ix.do
  eitherBodyParams <- parseForm
  result <- lift' $ fruitCreateDomainHandler eitherBodyParams
  logShow result
  badRequestHandler "Success"

fruitCreateDomainHandler :: Either String Form -> AppM Aff (Maybe String)
fruitCreateDomainHandler eitherBodyParams = do
  pool <- getPool
  liftAff $ withConnection pool (executeWithConnection eitherBodyParams)

executeWithConnection :: Either String Form -> Either PGError Connection -> Aff (Maybe String)
executeWithConnection eitherBodyParams eitherConn = 
  case prepareValues eitherConn eitherBodyParams of
    Right input -> liftPGQueryResult <$> (executeQueries input)
    Left e -> pure $ Just e

liftPGQueryResult :: Maybe PGError -> Maybe String
liftPGQueryResult result = case result of
  Nothing -> Nothing
  Just e -> Just (show e)

prepareValues :: (Either PGError Connection) -> (Either String Form) -> Either String {conn :: Connection, name :: String, delicious :: String, price :: String}
prepareValues eitherConn eitherBodyParams = do
  conn <- lmap show eitherConn
  params <- eitherBodyParams
  name <- required "name" params
  delicious <- required "delicious" params
  price <- required "price" params
  pure {conn, name, delicious, price}

executeQueries :: {conn :: Connection, name :: String, delicious :: String, price :: String} -> Aff (Maybe PGError)
executeQueries {conn, name, delicious, price} =
  let 
    query = Query "INSERT INTO fruits (name, delicious, price) VALUES ($1, $2, $3)"
    row = (Row3 name (castBoolean delicious) (Number.fromString price))
  in 
    execute conn query row

castBoolean :: String -> Boolean
castBoolean value = value == "on"

badRequestHandler ::  String -> Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
badRequestHandler message = send statusBadRequest (errorTemplate message)

postHandler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
postHandler = Ix.do
  bodyData <- parseForm 
  
  case bodyData of
    Right params -> case required "name" params of
      Right name -> send statusOK (greetTemplate name)
      _ -> badRequestHandler "Missing name"
    _ -> badRequestHandler "Invalid Body"

handler :: Middleware (AppM Aff) (ConnHttp StatusLineOpen) (ConnHttp ResponseEnded) Unit
handler = Ix.do
  requestData <- getRequestData
  case requestData.url of
    "/fruits" ->
      case requestData.method of
        Left GET -> fruitNewHandler
        Left POST -> fruitCreateHandler
        _ -> badRequestHandler "Unsupported method"
    _ ->
      case requestData.method of
        Left GET -> formHandler
        Left POST -> postHandler
        _ -> badRequestHandler "Unsupported method"

main :: Effect Unit
main = do
  pool <- newPool config
  runServer' defaultOptionsWithLogging {} (runAppM { pool: pool }) handler

thank you all for assistance :slight_smile: