Hi Tom,
I played a bit with your suggestion, and it is running now :-)
But instead of IO [Int] I think we need IO [Only Int] because of the 1-element-tupel problem?

With   IO [Only Int]   it looks like this:

-------------------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}

import Database.PostgreSQL.Simple

myconn :: ConnectInfo
myconn = defaultConnectInfo {
            connectUser = "test",
            connectPassword = "test",
            connectDatabase = "test"}

main :: IO ()
main = do
  c <- connect myconn :: IO Connection
  rs <- query_ c "select 2 + 2" :: IO [Only Int]
  putStrLn $ "Result from database " ++ show (fromOnly $ head rs)
  return ()
-------------------------------------------------------------------------------------------

Best regards
Hartmut

On 08/18/2013 12:11 AM, Tom Ellis wrote:
On Sat, Aug 17, 2013 at 11:59:24PM +0200, Hartmut Pfarr wrote:
{-# LANGUAGE OverloadedStrings #-}

import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow

hello :: (FromRow a) => IO [a]
hello = do
   conn <- connect defaultConnectInfo
   query_ conn "select 2 + 2"

Either

     main = print =<< (hello :: IO [Int])

or give hello a monomorphic type signature, such as

     hello :: IO [Int]

Tom

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to