Database.postgreSQL.Simple - ambigious type

Hello, I've a problem connecting to my postgresql database. Can You help me fix the ambigious type signature? (The example is identical to the first 5-liner-example in the package documentation) http://hackage.haskell.org/packages/archive/postgresql-simple/0.3.5.0/doc/ht... Kind regards Hartmut ------------------------------------------------------------------------ {-# LANGUAGE OverloadedStrings #-} import Database.PostgreSQL.Simple main = do conn <- connect defaultConnectInfo query conn "select 2 + 2" return () ------------------------------------------------------------------------ But this leads to error: ------------------------------------------------------------------------ Line 9: 1 error(s), 0 warning(s) Couldn't match expected type `IO a0' with actual type `q0 -> IO [r0]' In the return type of a call of `query' Probable cause: `query' is applied to too few arguments In a stmt of a 'do' block: query conn "select 2 + 2" In the expression: do { conn <- connect defaultConnectInfo; query conn "select 2 + 2"; return () } ------------------------------------------------------------------------ OK, I see, that a parameter q is missing. I change the source code to {-# LANGUAGE OverloadedStrings #-} import Database.PostgreSQL.Simple main = do conn <- connect defaultConnectInfo query conn "select 2 + 2" ( ) {- added ( ) here -} return () ------------------------------------------------------------------------ Now, I run into next error: ------------------------------------------------------------------------ Line 9: 1 error(s), 0 warning(s) No instance for (FromRow r0) arising from a use of `query' The type variable `r0' is ambiguous Possible fix: add a type signature that fixes these type variable(s) Note: there are several potential instances: instance (FromField a, FromField b) => FromRow (a, b) -- Defined in `Database.PostgreSQL.Simple.FromRow' instance (FromField a, FromField b, FromField c) => FromRow (a, b, c) -- Defined in `Database.PostgreSQL.Simple.FromRow' instance (FromField a, FromField b, FromField c, FromField d) => FromRow (a, b, c, d) -- Defined in `Database.PostgreSQL.Simple.FromRow' ...plus 10 others In a stmt of a 'do' block: query conn "select 2 + 2" () In the expression: do { conn <- connect defaultConnectInfo; query conn "select 2 + 2" (); return () } In an equation for `main': main = do { conn <- connect defaultConnectInfo; query conn "select 2 + 2" (); return () }

On Sat, Aug 17, 2013 at 1:35 PM, Hartmut Pfarr
(The example is identical to the first 5-liner-example in the package documentation)
As I read it, the example has a typo: it should be using `query_` instead of `query`. See http://hackage.haskell.org/packages/archive/postgresql-simple/0.3.5.0/doc/ht... detals. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

Thx, I changed now from query to query_ Now the coding is like that: ------------------------------------------------------------------------ {-# 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" main = return () ------------------------------------------------------------------------ I've no errors any more. But: I don't see any result (for sure, it is not coeded yet) I need some help to get data from "hello" via "FromRow" into the main function. E.g. I want to put the "hello" database result (the number "4") to the screen. Could anybody give an advice how I can accomplish this? Kind regards Hartmut On 08/17/2013 07:53 PM, Brandon Allbery wrote:
On Sat, Aug 17, 2013 at 1:35 PM, Hartmut Pfarr
mailto:hartmut0407@googlemail.com> wrote: (The example is identical to the first 5-liner-example in the package documentation)
As I read it, the example has a typo: it should be using `query_` instead of `query`. See http://hackage.haskell.org/packages/archive/postgresql-simple/0.3.5.0/doc/ht... for detals.
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com mailto:allbery.b@gmail.com ballbery@sinenomine.net mailto:ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

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

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

On Sun, Aug 18, 2013 at 10:16:06PM +0200, Hartmut Pfarr wrote:
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?
Yes you're right. I had forgotten that postgresql-simple dealt with single-column tables with "Only". Well done for getting it working! Tom

On Sat, Aug 17, 2013 at 5:59 PM, Hartmut Pfarr
query_ conn "select 2 + 2"
I've no errors any more. But: I don't see any result (for sure, it is not coeded yet)
Yes, because you're not capturing it; it's the return value from `query_`, which you are throwing away above instead of capturing with some kind of `res <- query_ ...`. Again, see that section of the documentation I pointed to for how to get results. -- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net

... thx all for helping. Now the coding works: it puts the following out. Kind regards Hartmut *Main> main Only {fromOnly = 4} ------------------------------ Only {fromOnly = 101} Only {fromOnly = 102} Only {fromOnly = 103} ------------------------------ blub 101 51 blub 102 52 blub 103 53 The Coding is: -- PostgreSQL-Simple test {-# LANGUAGE OverloadedStrings #-} import Database.PostgreSQL.Simple import Data.Foldable import qualified Data.Text as Text myconn :: ConnectInfo myconn = defaultConnectInfo { connectUser = "test", connectPassword = "test", connectDatabase = "test"} db_calc :: (FromRow a) => IO [a] db_calc = do conn <- connect myconn query_ conn "select 2 + 2" hr :: IO () hr = putStrLn "------------------------------" main :: IO () main = do conn <- connect myconn -- Let Database calculate 2+2 x1 <- db_calc forM_ x1 $ \h -> putStrLn $ show (h :: Only Int) -- Select single integer column hr; x2 <- query_ conn "select aaa from aaa" forM_ x2 $ \(col1) -> putStrLn $ show (col1 :: Only Int) -- select integer and text columns together hr; x3 <- query_ conn "select aaa,bbb,textcol from aaa" forM_ x3 $ \(int_col_1,int_col_2,text_col_3) -> putStrLn $ Text.unpack text_col_3 ++ " " ++ show (int_col_1 :: Int) ++ " " ++ show (int_col_2 :: Int) return () On 08/18/2013 12:12 AM, Brandon Allbery wrote:
On Sat, Aug 17, 2013 at 5:59 PM, Hartmut Pfarr
mailto:hartmut0407@googlemail.com> wrote: query_ conn "select 2 + 2"
I've no errors any more. But: I don't see any result (for sure, it is not coeded yet)
Yes, because you're not capturing it; it's the return value from `query_`, which you are throwing away above instead of capturing with some kind of `res <- query_ ...`. Again, see that section of the documentation I pointed to for how to get results.
-- brandon s allbery kf8nh sine nomine associates allbery.b@gmail.com mailto:allbery.b@gmail.com ballbery@sinenomine.net mailto:ballbery@sinenomine.net unix, openafs, kerberos, infrastructure, xmonad http://sinenomine.net
participants (3)
-
Brandon Allbery
-
Hartmut Pfarr
-
Tom Ellis