[Haskell-beginners] Re: ghci access to .hs functions
MAN
elviotoccalino at gmail.com
Thu Aug 12 17:08:47 EDT 2010
The problem in the "all" case branch is that, although you applied the
mapM-to-mapM_ modification, you didn't change the type signature of
gtKys accordingly:
mapM :: (a -> m b) -> m a -> m [b]
mapM_ :: (a -> m b) -> m a -> m ()
In your case 'a' above is whatever 'fromSql' returns for your program (I
can't infer it... which might explain the lengthy type signature), and
'b' is simply '()'. So 'b=()' which means the type of 'gtKys' is no
longer:
gtKys :: (IConnection conn) => conn -> IO [()] -- using 'mapM'
gtKys :: (IConnection conn) => conn -> IO () -- using 'mapM_'
Two more things to say:
You should know that '()' is both a type AND a value... kind of strange.
'()' designates a type of "things" (like 'Int' and 'Double' do for
integers and double-precision numbers), but the kink is that the only
"thing" of such type is a value known as 'unit' which is written (for
good or bad) '()'.
As a mental help... all functions in Control.Monad (and several other
modules as well) that end in '_' "throw away" their results; meaning
that they return 'unit' regardless of their action.
"however, i still don't quite understand what the return is doing beyond
you seem to need it in order to get things out of a monad associated
function." Pan, I think It's time for you to get serious with the monads
XD I can't suggest anything, 'cause I read a whole lot before my brain
started to understand any of it... but maybe you should check out
articles, looking for real monad-related answers to your more general
questions (in particular you seem to be getting hit by "getting a value
out of a monad").
Try the en.wikibooks.org/wiki/Haskell or learnyouahaskell.org and skip
to the sections where do-notation and monadic computations are
discussed. Just rememeber: "Don't Panic".
El jue, 12-08-2010 a las 13:18 -0700, prad escribió:
> On Thu, 12 Aug 2010 12:00:44 -0300
> MAN <elviotoccalino at gmail.com> wrote:
>
> > couple of things
> > you could be interested to know.
> >
> most definitely! i very much appreciate the help, el.
> thx to you too brent for clearing up the ExitCode problem
>
> > Your main will allways be 'IO ()' , but that doesn't mean you must
> > sparkle 'return ()' all over the place :P
> >
> well i have been specializing in random programming => just keep trying
> things randomly and hope it works. :D
>
> putting return() in the "all" worked (no idea why), so i thought it
> must be a good thing and put it in the other two. :D
>
> i'd also used mapM because map didn't work and i figured it had
> something to do with monads and M is the first letter in monad. :D
>
> i really have to get away from this sort of thing and i'm trying to
> figure out the excellent stuff etugrul and kyle provided in the
> = vs <- thread.
>
> now i tried taking the returns out and things are fine for "add" and
> "upd", but even with the changes you suggested for gtKys (mapM to
> mapM_) i'm getting these errors:
>
> ======
> gadit.hs:30:19:
> Couldn't match expected type `()' against inferred type `[()]'
> Expected type: IO ()
> Inferred type: IO [()]
> In the expression: gtKys conn
> In a case alternative: "all" -> gtKys conn
>
> gadit.hs:66:4:
> Couldn't match expected type `[()]' against inferred type `()'
> Expected type: IO [()]
> Inferred type: IO ()
> In the expression: mapM_ (mkPag conn) kL
> In the expression:
> do { r <- quickQuery conn "SELECT key from main" [];
> let kL = concat $ map (map fromSql) r;
> mapM_ (mkPag conn) kL }
> =======
>
> it want some sort of list and i'm not providing it.
>
> here is the code in question with the line numbers:
>
> =======
>
> 21 main = do
> 22 args <- getArgs
> 23 let act = head args
> 24 conn <- connectPostgreSQL "host=localhost dbname=lohv
> user=pradmin"
> 25 case act of
> 26 "add" -> do
> 27 kV1 <- dbDef conn
> 28 upDbs conn (fromSql kV1)
> 29 "upd" -> upDbs conn (last args)
> 30 "all" -> gtKys conn
> 31 _ -> putStrLn "add, upd num, all only!!"
> 32 commit conn
> 33 disconnect conn
> 34 putStrLn "All Done!"
>
> ...
>
> 61 -- gtKys: gets all key values in database
> 62 gtKys :: (IConnection conn) => conn -> IO [()]
> 63 gtKys conn = do
> 64 r <- quickQuery conn "SELECT key from main" []
> 65 let kL = concat $ map (map fromSql) r
> 66 mapM_ (mkPag conn) kL
>
> ========
>
> now i got to thinking about all this and realized that gtKys really
> shouldn't have
> mapM_ (mkPag conn) kL
> in there anyway because its job is to just get some key values not to
> make Pages (mkPag)
> in fact, i only put it in there because i couldn't figure out how to
> get the stuff out - as kyle says in the other thread:
> "once something is "inside" of a monad (IO in this case), it's very
> difficult, impossible, to get it out again."
>
> so what i did is rewrite the code like this:
> case act of
> ...
> "all" -> do
> kyL <- gtKys conn
> mapM_ (mkPag conn) kyL
>
> and
>
> gtKys conn = do
> r <- quickQuery conn "SELECT key from main" []
> return $ concat $ map (map fromSql) r
>
> it all works now.
>
> gtKys now has the lengthy type:
> gtKys :: (IConnection conn, Data.Convertible.Base.Convertible SqlValue
> a) => conn -> IO [a]
>
> which i'm leaving out since it generates a scope error unless i import
> something else (as brent explained in the above post regarding
> ExitCode).
>
> however, i still don't quite understand what the return is doing beyond
> you seem to need it in order to get things out of a monad associated
> function. whenever i have an IO () i seem to require it.
>
> there seem to be several ways to ask functions to provide computations
> and require specific ways to get access to them.
>
>
> --
> In friendship,
> prad
>
> ... with you on your journey
> Towards Freedom
> http://www.towardsfreedom.com (website)
> Information, Inspiration, Imagination - truly a site for soaring I's
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
More information about the Beginners
mailing list