<div dir="ltr"><div><div><br></div>Thank you!<br><br></div>You're correct; I had been thinking of do notation as a "multistatement" thing rather than as a monad thing.<br></div><div class="gmail_extra"><br><div class="gmail_quote">On Wed, Dec 2, 2015 at 5:05 AM, David McBride <span dir="ltr"><<a href="mailto:toad3k@gmail.com" target="_blank">toad3k@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div>You seem to be having some problems understanding how Monads and do notation work.<span class=""><br><br>do_prefix_hash :: String -> (IO String, String)<br>do_prefix_hash filename = do<br> hash <- Md5s.prefix_md5 filename :: (IO String)<br> (hash, filename)<br><br></span></div>The above is ill typed. When you open with a do, from that point on the type will be Monad m => String -> m Something. But what you intended to return is a tuple, which is not an instance of monad. Don't use do in this case, just return a tuple.<br><div><div><span class=""><br>do_prefix_hash :: String -> (IO String, String)<br></span>do_prefix_hash filename = (Md5s.prefix_md5 filename, filename)<br><br></div><div>Just look closely at what the error is telling you. Is it expecting a type that you told it it returns but it is detecting that your code would return something else.<br></div><div><br></div></div></div><div class="gmail_extra"><br><div class="gmail_quote"><div><div class="h5">On Tue, Dec 1, 2015 at 7:12 PM, Dan Stromberg <span dir="ltr"><<a href="mailto:strombrg@gmail.com" target="_blank">strombrg@gmail.com</a>></span> wrote:<br></div></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div><div class="h5"><div dir="ltr"><br clear="all"><div>I'm continuing my now-and-then exploration of Haskell.</div><div><br></div><div>I'm getting a new crop of type errors that I'm pulling my hair out over.</div><div><br></div><div>The errors I'm getting are:</div><div><br></div><div><div>$ make</div><div>below cmd output started 2015 Tue Dec 01 04:05:17 PM PST</div><div># --make will go out and find what to build</div><div>ghc -Wall --make -o dph dph.hs Split0.hs</div><div>[1 of 3] Compiling Split0 ( Split0.hs, Split0.o )</div><div>[2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o )</div><div>[3 of 3] Compiling Main ( dph.hs, dph.o )</div><div><br></div><div>dph.hs:13:13:</div><div> Couldn't match type `IO' with `(,) (IO String)'</div><div> Expected type: (IO String, String)</div><div> Actual type: IO String</div><div> In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String</div><div> In the expression:</div><div> do { hash <- prefix_md5 filename :: IO String;</div><div> (hash, filename) }</div><div> In an equation for `do_prefix_hash':</div><div> do_prefix_hash filename</div><div> = do { hash <- prefix_md5 filename :: IO String;</div><div> (hash, filename) }</div><div><br></div><div>dph.hs:14:6:</div><div> Couldn't match type `[Char]' with `IO String'</div><div> Expected type: IO String</div><div> Actual type: String</div><div> In the expression: hash</div><div> In a stmt of a 'do' block: (hash, filename)</div><div> In the expression:</div><div> do { hash <- prefix_md5 filename :: IO String;</div><div> (hash, filename) }</div><div><br></div><div>dph.hs:24:23:</div><div> Couldn't match type `[]' with `IO'</div><div> Expected type: IO (IO String, String)</div><div> Actual type: [(IO String, String)]</div><div> In a stmt of a 'do' block:</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)]</div><div> In the expression:</div><div> do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)];</div><div> .... }</div><div> In an equation for `main':</div><div> main</div><div> = do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> .... }</div><div><br></div><div>dph.hs:25:20:</div><div> Couldn't match type `[a0]' with `(String, String)'</div><div> Expected type: [(String, String)]</div><div> Actual type: [[a0]]</div><div> In the return type of a call of `sequence'</div><div> In a stmt of a 'do' block:</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)]</div><div> In the expression:</div><div> do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)];</div><div> .... }</div><div><br></div><div>dph.hs:25:20:</div><div> Couldn't match type `[]' with `IO'</div><div> Expected type: IO (String, String)</div><div> Actual type: [(String, String)]</div><div> In a stmt of a 'do' block:</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)]</div><div> In the expression:</div><div> do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)];</div><div> .... }</div><div> In an equation for `main':</div><div> main</div><div> = do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> .... }</div><div><br></div><div>dph.hs:25:29:</div><div> Couldn't match expected type `[[a0]]'</div><div> with actual type `(IO String, String)'</div><div> In the first argument of `sequence', namely `io_hash_tuples'</div><div> In a stmt of a 'do' block:</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)]</div><div> In the expression:</div><div> do { buffer <- (hGetContents stdin) :: IO String;</div><div> let filenames = ...;</div><div> io_hash_tuples <- map do_prefix_hash filenames ::</div><div> [(IO String, String)];</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)];</div><div> .... }</div><div><br></div><div>dph.hs:26:39:</div><div> Couldn't match expected type `[(String, String)]'</div><div> with actual type `(String, String)'</div><div> In the second argument of `map', namely `hash_tuples'</div><div> In the expression: map tuple_to_string hash_tuples :: [String]</div><div> In an equation for `strings':</div><div> strings = map tuple_to_string hash_tuples :: [String]</div><div>make: *** [dph] Error 1</div><div>above cmd output done 2015 Tue Dec 01 04:05:18 PM PST</div></div><div><br></div><div><br></div><div>dph.hs looks like:</div><div><div>import Md5s</div><div>import Split0</div><div>import System.IO</div><div><br></div><div>get_filenames :: String -> [String]</div><div>get_filenames buffer = do</div><div> -- Let's hope this doesn't give locale-related roundtrip problems.</div><div> Split0.split0 '\0' buffer :: [String]</div><div><br></div><div>do_prefix_hash :: String -> (IO String, String)</div><div>do_prefix_hash filename = do</div><div> hash <- Md5s.prefix_md5 filename :: (IO String)</div><div> (hash, filename)</div><div><br></div><div>tuple_to_string :: (String, String) -> String</div><div>tuple_to_string (first, second) = do</div><div> (show first) ++ " " ++ (show second)</div><div><br></div><div>main :: IO ()</div><div>main = do</div><div> buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String</div><div> let filenames = (get_filenames buffer) :: [String]</div><div> io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]</div><div> hash_tuples <- sequence io_hash_tuples :: [(String, String)]</div><div> let strings = map tuple_to_string hash_tuples :: [String]</div><div> mapM_ putStrLn strings</div></div><div><br></div><div><br></div><div>And Md5s.hs looks like:</div><div><div>module Md5s where</div><div><br></div><div>import qualified System.IO</div><div>import qualified Text.Printf</div><div>-- cabal install cryptohash</div><div>import qualified Crypto.Hash.MD5</div><div>import qualified Data.ByteString</div><div>import qualified Data.ByteString.Lazy</div><div><br></div><div>-- <a href="http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation" target="_blank">http://stackoverflow.com/questions/10099921/efficiently-turn-a-bytestring-into-a-hex-representation</a></div><div>byte_string_to_hex :: Data.ByteString.ByteString -> String</div><div>byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . Data.ByteString.unpack</div><div><br></div><div>prefix_md5 :: String -> IO String</div><div>prefix_md5 filename = do</div><div> let prefix_length = 1024</div><div> file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle</div><div> data_read <- Data.ByteString.hGet file prefix_length :: IO Data.ByteString.ByteString</div><div> _ <- System.IO.hClose file</div><div> let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx</div><div> let hasher2 = Crypto.Hash.MD5.update hasher data_read :: Crypto.Hash.MD5.Ctx</div><div> let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: Data.ByteString.ByteString</div><div> let hex_digest = byte_string_to_hex binary_digest :: String</div><div> return hex_digest :: IO String</div><div><br></div><div>full_md5 :: String -> IO String</div><div>full_md5 filename = do</div><div> file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle</div><div> data_read <- Data.ByteString.Lazy.hGetContents file :: IO Data.ByteString.Lazy.ByteString</div><div> let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: Data.ByteString.ByteString</div><div> let hex_digest = byte_string_to_hex binary_digest :: String</div><div> -- Does this get closed for us later?</div><div> -- strace shows the file getting closed without our explicit close.</div><div> -- _ <- System.IO.hClose file</div><div> return hex_digest :: IO String</div></div><div><br></div><div><br></div><div>It might be easier to view these at <a href="http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/" target="_blank">http://stromberg.dnsalias.org/svn/equivalence-classes/trunk/equivs3-haskell/</a> , so the line numbers are precise.</div><div><br></div><div>What is the deal?</div><div><br></div><div>Can anyone tell me what should be running through my head to fix this kind of problem on my own in the future?</div><div><br></div><div>Thanks!</div><span><font color="#888888"><div><br></div>-- <br><div>Dan Stromberg</div>
</font></span></div>
<br></div></div><span class="">_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org" target="_blank">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners</a><br>
<br></span></blockquote></div><br></div>
<br>_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners</a><br>
<br></blockquote></div><br><br clear="all"><br>-- <br><div class="gmail_signature">Dan Stromberg</div>
</div>