(Wow, it looks like my message has generated quite a bit of traffic!
Thanks, guys!)

On 12/11/06, Taral <[EMAIL PROTECTED]> wrote:
The magic commands are:

runhaskell Setup.lhs configure
runhaskell Setup.lhs build
runhaskell Setup.lhs install

Excellent! Now I'm getting somewhere. I even found the sample code in
the takusen documentation.

I'm trying to modify the sample code to work with a local database I
have, and I'm getting some type errors which mean nothing much to me.
The code I have, stored in a file called db.hs and run via "runhaskell
db.hs" is:

import Control.Monad.Trans
import Database.Oracle.Enumerator
import Database.Enumerator

query1Iteratee :: (Monad m) => String -> IterAct m [String]
query1Iteratee a accum = result' (a:accum)

main :: IO ()
main = do
  withSession (connect "USER" "PASSWORD" "DB") $ do
    -- simple query, returning reversed list of rows.
    r <- doQuery (sql "select username from all_users") query1Iteratee []
    liftIO $ putStrLn $ show r


The error I'm getting is

db.hs:10:64:
   Couldn't match expected type `forall mark. DBM mark Session a'
          against inferred type `a1 b'
   In the second argument of `($)', namely
       `do r <- doQuery
                  (sql "select username from all_users") query1Iteratee []
             liftIO $ (putStrLn $ (show r))'
   In the expression:
         (withSession (connect "USER" "PASSWORD" "DB"))
       $ (do r <- doQuery
                    (sql "select username from all_users") query1Iteratee []
               liftIO $ (putStrLn $ (show r)))
   In the expression:
       do (withSession (connect "USER" "PASSWORD" "DB"))
        $ (do r <- doQuery
                     (sql "select username from all_users") query1Iteratee []
                liftIO $ (putStrLn $ (show r)))

I'm not sure what might be wrong here - or even, for that matter, how
to diagnose the problem. To complicate the matter, it's possible that
I'm getting a database connection error  which I've not got code in to
report. (I've no easy way to test that the database connection from
Haskell is working, or rather *this* is the easy way :-))

Can anyone offer any pointers? (I take the suggestions about asking on
IRC, but I can't get at IRC from here due to firewall issues, so I'll
have to stick to email).

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

Reply via email to