[Takusen] working out how to use bind variables

Michael Litchard michael at schmong.org
Tue Aug 17 21:46:46 EDT 2010


Thanks for everyone's help. Here is where I'm at right now.

> import Database.PostgreSQL.Enumerator
> import Database.Enumerator
> import Control.Monad.Trans

> insertPair :: (String, Int) -> DBM mark s Int
> insertPair act_entry = (execDML (cmdbind "insert into activities (Activity, Cost) values (?, ?)" [bindP activity, bindP cost]))
>     where activity = fst act_entry
>           cost     = snd act_entry

> main :: IO ()
> main = do
>  let connection = connect [CAdbname "tutorialDB"]
>  withSession connection $ do
>  let activities :: [(String, Int)]
>      activities = [("Golf", 47), ("Sailing", 50), ("Squash", 40), ("Swimming", 15), ("Tennis", 36)]
>  execDDL (sql "create table activities (Activity char(20) PRIMARY KEY, cost int)")

>  return $ liftIO $ map insertPair activities

The errors I receive are these.

tutorial.lhs:6:26:
    Could not deduce (Command
                        Database.PostgreSQL.Enumerator.CommandBind s)
      from the context ()
      arising from a use of `execDML' at tutorial.lhs:6:26-127
    Possible fix:
      add (Command
             Database.PostgreSQL.Enumerator.CommandBind s) to the context of
        the type signature for `insertPair'
      or add an instance declaration for
         (Command Database.PostgreSQL.Enumerator.CommandBind s)
    In the expression:
        (execDML
           (cmdbind
              "insert into activities (Activity, Cost) values (?, ?)"
              [bindP activity, bindP cost]))
    In the definition of `insertPair':
        insertPair act_entry
                     = (execDML
                          (cmdbind
                             "insert into activities (Activity, Cost) values (?,
 ?)"
                             [bindP activity, bindP cost]))
                     where
                         activity = fst act_entry


tutorial.lhs:18:21:
    Couldn't match expected type `IO a'
           against inferred type `[DBM mark s Int]'
    In the second argument of `($)', namely `map insertPair activities'
    In the second argument of `($)', namely
        `liftIO $ map insertPair activities'
    In the expression: return $ liftIO $ map insertPair activities


I'd like to deal with one at a time, the top one first.

It was suggested in #haskell that I find out what ghci infers the type of

insertPair. So I wrote this:
> import Database.PostgreSQL.Enumerator
> import Database.Enumerator
> import Control.Monad.Trans

> insertPair act_entry = (execDML (cmdbind "insert into activities (Activity, Cost) values (?, ?)" [bindP activity, bindP cost]))
>     where activity = fst act_entry
>           cost     = snd act_entry

and did this in ghci
*Main> :t insertPair
insertPair
  :: (DBBind
        a
        Session
        Database.PostgreSQL.Enumerator.PreparedStmtObj
        Database.PostgreSQL.Enumerator.BindObj,
      DBBind
        b
        Session
        Database.PostgreSQL.Enumerator.PreparedStmtObj
        Database.PostgreSQL.Enumerator.BindObj,
      Command Database.PostgreSQL.Enumerator.CommandBind s) =>
     (a, b) -> DBM mark s Int

Could someone help me make sense out of what ghci is expecting me to
do to fix the first problem? I'm hoping the second problem becomes
clearer when the first is dealt with.

Thanks.

Michael





On Wed, Aug 11, 2010 at 3:21 PM, Gregory Crosswhite
<gcross at phys.washington.edu> wrote:
>  The problem is that you are promising that "main" is of type "IO ()",
> but the last expression in main is
>
>    withSession connection (execDML (cmdbind "insert into activities
> (Activity, Cost) values (?, ?)" [bindP foo, bindP bar]))
>
> which is of type "IO Int", since execDML returns the number of rows that
> were modified.  Thus, main is actually of type "IO Int", violating your
> type constraint.
>
> Cheers,
> Greg
>
>
> On 08/11/10 11:45, Michael Litchard wrote:
>> Here's some toy code I have been playing with. The first few attempts
>> work fine, but the final line, where I try to use bind variables,
>> becomes a problem.
>>
>>
>>
>>> import Database.PostgreSQL.Enumerator
>>> import Database.Enumerator
>>> main :: IO ()
>>> main = do
>>> let connection = connect [CAdbname "tutorialDB"]
>>> let foo = "test"
>>> let bar = 42
>>> withSession connection (execDDL (sql "create table activities (Activity char(20) PRIMARY KEY, cost int)"))
>>> withSession connection (execDDL (sql "create table students (Student char (20), ID int PRIMARY KEY)"))
>>> withSession connection (execDDL (sql "create table participants (Activity char (20) REFERENCES activities , ID int PRIMARY KEY)"))
>>> withSession connection (execDDL (sql "insert into activities (Activity,Cost) values ('golf', 27)"))
>>> withSession connection (execDML (cmdbind "insert into activities (Activity, Cost) values (?, ?)" [bindP foo, bindP bar]))
>>
>> tutorial.lhs:16:26:
>>     Couldn't match expected type `()' against inferred type `Int'
>>       Expected type: DBM mark Session ()
>>       Inferred type: DBM mark Session Int
>>     In the second argument of `withSession', namely
>>         `(execDML
>>             (cmdbind
>>                "insert into activities (Activity, Cost) values (?, ?)"
>>                [bindP foo, bindP bar]))'
>>     In the expression:
>>         withSession
>>           connection
>>           (execDML
>>              (cmdbind
>>                 "insert into activities (Activity, Cost) values (?, ?)"
>>                 [bindP foo, bindP bar]))
>>
>>
>> I know this means I need to fix the type, but I don't know how. I've
>> been looking at the code used for testing, plus the usage examples
>> from Enumerator.lhs. Haven't quite got it. Any help pointing me in the
>> right direction would be much welcome.
>>
>> Michael Litchard
>>
>> _______________________________________________
>> Takusen mailing list
>> Takusen at projects.haskell.org
>> http://projects.haskell.org/cgi-bin/mailman/listinfo/takusen
>
>
> _______________________________________________
> Takusen mailing list
> Takusen at projects.haskell.org
> http://projects.haskell.org/cgi-bin/mailman/listinfo/takusen
>



More information about the Takusen mailing list