I'm continuing my now-and-then exploration of Haskell.
I'm getting a new crop of type errors that I'm pulling my hair out over.
$ make
below cmd output started 2015 Tue Dec 01 04:05:17 PM PST
# --make will go out and find what to build
ghc -Wall --make -o dph dph.hs Split0.hs
[1 of 3] Compiling Split0 ( Split0.hs, Split0.o )
[2 of 3] Compiling Md5s ( Md5s.hs, Md5s.o )
[3 of 3] Compiling Main ( dph.hs, dph.o )
dph.hs:13:13:
Couldn't match type `IO' with `(,) (IO String)'
Expected type: (IO String, String)
Actual type: IO String
In a stmt of a 'do' block: hash <- prefix_md5 filename :: IO String
In the expression:
do { hash <- prefix_md5 filename :: IO String;
(hash, filename) }
In an equation for `do_prefix_hash':
do_prefix_hash filename
= do { hash <- prefix_md5 filename :: IO String;
(hash, filename) }
dph.hs:14:6:
Couldn't match type `[Char]' with `IO String'
Expected type: IO String
Actual type: String
In the expression: hash
In a stmt of a 'do' block: (hash, filename)
In the expression:
do { hash <- prefix_md5 filename :: IO String;
(hash, filename) }
dph.hs:24:23:
Couldn't match type `[]' with `IO'
Expected type: IO (IO String, String)
Actual type: [(IO String, String)]
In a stmt of a 'do' block:
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)]
In the expression:
do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
hash_tuples <- sequence io_hash_tuples :: [(String, String)];
.... }
In an equation for `main':
main
= do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
.... }
dph.hs:25:20:
Couldn't match type `[a0]' with `(String, String)'
Expected type: [(String, String)]
Actual type: [[a0]]
In the return type of a call of `sequence'
In a stmt of a 'do' block:
hash_tuples <- sequence io_hash_tuples :: [(String, String)]
In the expression:
do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
hash_tuples <- sequence io_hash_tuples :: [(String, String)];
.... }
dph.hs:25:20:
Couldn't match type `[]' with `IO'
Expected type: IO (String, String)
Actual type: [(String, String)]
In a stmt of a 'do' block:
hash_tuples <- sequence io_hash_tuples :: [(String, String)]
In the expression:
do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
hash_tuples <- sequence io_hash_tuples :: [(String, String)];
.... }
In an equation for `main':
main
= do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
.... }
dph.hs:25:29:
Couldn't match expected type `[[a0]]'
with actual type `(IO String, String)'
In the first argument of `sequence', namely `io_hash_tuples'
In a stmt of a 'do' block:
hash_tuples <- sequence io_hash_tuples :: [(String, String)]
In the expression:
do { buffer <- (hGetContents stdin) :: IO String;
let filenames = ...;
io_hash_tuples <- map do_prefix_hash filenames ::
[(IO String, String)];
hash_tuples <- sequence io_hash_tuples :: [(String, String)];
.... }
dph.hs:26:39:
Couldn't match expected type `[(String, String)]'
with actual type `(String, String)'
In the second argument of `map', namely `hash_tuples'
In the expression: map tuple_to_string hash_tuples :: [String]
In an equation for `strings':
strings = map tuple_to_string hash_tuples :: [String]
make: *** [dph] Error 1
above cmd output done 2015 Tue Dec 01 04:05:18 PM PST
import Md5s
import Split0
import System.IO
get_filenames :: String -> [String]
get_filenames buffer = do
-- Let's hope this doesn't give locale-related roundtrip problems.
Split0.split0 '\0' buffer :: [String]
do_prefix_hash :: String -> (IO String, String)
do_prefix_hash filename = do
hash <- Md5s.prefix_md5 filename :: (IO String)
(hash, filename)
tuple_to_string :: (String, String) -> String
tuple_to_string (first, second) = do
(show first) ++ " " ++ (show second)
main :: IO ()
main = do
buffer <- (System.IO.hGetContents System.IO.stdin) :: IO String
let filenames = (get_filenames buffer) :: [String]
io_hash_tuples <- map do_prefix_hash filenames :: [(IO String, String)]
hash_tuples <- sequence io_hash_tuples :: [(String, String)]
let strings = map tuple_to_string hash_tuples :: [String]
mapM_ putStrLn strings
module Md5s where
import qualified System.IO
import qualified Text.Printf
-- cabal install cryptohash
import qualified Crypto.Hash.MD5
import qualified Data.ByteString
import qualified Data.ByteString.Lazy
byte_string_to_hex :: Data.ByteString.ByteString -> String
byte_string_to_hex = concatMap (Text.Printf.printf "%02x") . Data.ByteString.unpack
prefix_md5 :: String -> IO String
prefix_md5 filename = do
let prefix_length = 1024
file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle
data_read <- Data.ByteString.hGet file prefix_length :: IO Data.ByteString.ByteString
_ <- System.IO.hClose file
let hasher = Crypto.Hash.MD5.init :: Crypto.Hash.MD5.Ctx
let hasher2 = Crypto.Hash.MD5.update hasher data_read :: Crypto.Hash.MD5.Ctx
let binary_digest = Crypto.Hash.MD5.finalize hasher2 :: Data.ByteString.ByteString
let hex_digest = byte_string_to_hex binary_digest :: String
return hex_digest :: IO String
full_md5 :: String -> IO String
full_md5 filename = do
file <- System.IO.openBinaryFile filename System.IO.ReadMode :: IO System.IO.Handle
data_read <- Data.ByteString.Lazy.hGetContents file :: IO Data.ByteString.Lazy.ByteString
let binary_digest = Crypto.Hash.MD5.hashlazy data_read :: Data.ByteString.ByteString
let hex_digest = byte_string_to_hex binary_digest :: String
-- Does this get closed for us later?
-- strace shows the file getting closed without our explicit close.
-- _ <- System.IO.hClose file
return hex_digest :: IO String
Can anyone tell me what should be running through my head to fix this kind of problem on my own in the future?