HDBC and Servant, Handle error on build

Hello, I am messing around with HDBC and servant. I am implementing a “/users” api endpoint that simply returns a list of users.

data User = User
  { username :: String
  , firstName :: String
  , email :: String
  , password :: String
  } deriving (Eq, Show, Generic)
instance ToJSON User

type UsersRoute =  "users" :> Get '[JSON] [User]

fromSqlRowToUser :: [SqlValue] -> User
fromSqlRowToUser row = User username firstname email password
  where
    extractedRow = map fromSql row
    username = extractedRow !! 0
    firstname = extractedRow !! 1
    email = extractedRow !! 2
    password = extractedRow !! 3

-- routers handles
usersHandle :: PostgresConnection -> [User]
usersHandle conn = do
  select <- prepare conn "SELECT * FROM users;"
  _ <- execute select []
  result <- fetchAllRows select
  return $ map fromSqlRowToUser result

I get this error shown below. Expected [User], but got [[User]]. This is strange and I cannot explain why this error appears.

    • Couldn't match type ‘[User]’ with ‘User’
      Expected: [User]
        Actual: [[User]]
    • In a stmt of a 'do' block: return $ map fromSqlRowToUser result
      In the expression:
        do select <- prepare conn "SELECT * FROM users;"
           _ <- execute select []
           result <- fetchAllRows select
           return $ map fromSqlRowToUser result
      In an equation for ‘usersHandle’:
          usersHandle conn
            = do select <- prepare conn "SELECT * FROM users;"
                 _ <- execute select []
                 result <- fetchAllRows select
                 ....
   |
97 |   return $ map fromSqlRowToUser result

What is the type of result?

1 Like

This looks suspicious

usersHandle :: PostgresConnection -> [User]

should it perhaps be

usersHandle :: PostgresConnection -> IO [User]
1 Like
ghci> :t result
result :: [[SqlValue]]

If I show the result, it is as follows:
[[SqlByteString “john”,SqlByteString “John”,SqlByteString “john@gmail.com”,SqlByteString “johnpwd”],[SqlByteString “linda”,SqlByteString “Linda”,SqlByteString “linda@gmail.com”,SqlByteString “lindapwd”]]

If I use this definition

usersHandle :: PostgresConnection → Server UsersRoute

, I get the error

Couldn't match type: IO [User]
                     with: Handler [User]
      Expected: Server UsersRoute
        Actual: IO [User]

The problem is with return.

As @tomjaguarpaw said, you probably meant IO [User].

Explanation:

return :: Monad m => a -> m a

When your function is from … -> [User], (which can be written as … -> ([]) User), when you write in the end return something, the inferred type is return :: a -> [a].

Because you return (something :: [User]), the resulting type is [[User]] which doesn’t match [User].

If you remove the return you’ll get further errors because of the do notation (…)

1 Like

This version has the most sense, because the resulting type is IO [User], but still does not compile

usersHandle :: PostgresConnection -> IO [User]
usersHandle conn = do
  select <- prepare conn "SELECT * FROM users;"
  _ <- execute select []
  result <- fetchAllRows select
  let users = map fromSqlRowToUser result
  return users

Error:

    • Couldn't match type: IO [User]
                     with: Handler [User]
      Expected: Server Router
        Actual: IO [User]

The explanation is more complicated, however the solution is probably

usersHandle :: PostgresConnection -> Server UsersRoute
usersHandle conn = do
  select <- liftIO $ prepare conn "SELECT * FROM users;"
  _ <- liftIO $ execute select []
  result <- liftIO $ fetchAllRows select
  let users = map fromSqlRowToUser result
  return users
1 Like

This version works. Excellent. You are a hero :grinning:

1 Like

Context:

fetchAllRows :: Statement -> IO [[SqlValue]]
prepare :: IConnection conn => conn -> String -> IO Statement
execute :: Statement -> [SqlValue] -> IO Integer

and

usersHandle :: PostgresConnection -> Server UsersRoute

is the Server that implements your API UsersRoute

You want to call the three functions above from usersHandle, but won’t be able to!
An explanation here won’t paint the whole picture – there’s a lot going on.

But in short, your HDBC functions return IO something, and your usersHandle returns Server UsersRoute, and IO and Server don’t “match”.

However, there’s a nice function called liftIO :: MonadIO m => IO a -> m a which reads "If m instances MonadIO, then a value of type IO a can be transformed into m a". And luckily, the Handler monad you’re implicitly using when you write Server UsersRoute instances MonadIO (This means, somewhere, there’s instance MonadIO Handler)

To conclude, you get a value with type IO something when you use HDBC, and you can transform IO something into Handler something using liftIO. And Handler something already matches your server (because Server UsersRoute is actually the same as Handler [User])

1 Like

You can factor out the liftIO to make it a bit cleaner.

You can have

usersHandle :: PostgresConnection -> Server UsersRoute
usersHandle conn = do
  result <- liftIO $ do
      select <- prepare conn "SELECT * FROM users;"
      execute select []
      fetchAllRows select
  let users = map fromSqlRowToUser result
  return users

You could, technically, also have (while not as good as the above imo)

usersHandle :: PostgresConnection -> Server UsersRoute
usersHandle conn = liftIO $ do
  select <- prepare conn "SELECT * FROM users;"
  execute select []
  result <- fetchAllRows select
  let users = map fromSqlRowToUser result
  return users

But map fromSqlRowToUser isn’t concerned with IO, so it’s good practice to have it “outside” of liftIO (therefore only IO values are lifted with liftIO and we have better separation of concerns + etc) (also liftIO $ return x can be slower than just return x, or so I’ve heard)

1 Like