A better type signature for `forM_`
David Feuer
david.feuer at gmail.com
Fri Apr 1 04:12:12 UTC 2016
I think it's an interesting idea from a safety standpoint. Unfortunately,
as Ed pointed out to me in a similar context, `void` isn't always free.
On Mar 31, 2016 7:22 PM, "Erik de Castro Lopo" <mle+hs at mega-nerd.com> wrote:
> Hi all,
>
> I was recently faced with some unexpected behaviour from a piece of
> code that type checks and has zero warnings (even with -Wall). The
> code is below (and depends on the hashtables package).
>
> The error was using the <$> operator instead of the =<< operator.
> Using the former, it just builds up a list of IO actions that never
> get run.
>
> As pointed out to me on IRC (thanks pjdeport), chaning the type
> signature of `forM_` to
>
> forM_' :: (Monad m, Foldable t) => t a -> (a -> m ()) -> m ()
>
> would have resulted in an error.
>
> Yes, this change would break existing code (breaking code would require
> an explicit `void $` inside the `forM_`) but does anyone else think
> this is a good idea?
>
> Erik
>
>
>
> import Control.Monad
>
> import qualified Data.HashTable.IO as HT
>
> type EvenCache = HT.BasicHashTable Int Bool
>
> main :: IO ()
> main = do
> ht <- buildTable
> xs <- HT.toList ht
> putStrLn $ "cache: length " ++ show (length xs)
>
> buildTable :: IO EvenCache
> buildTable = do
> ht <- HT.new
> forM_ pairs $ \ (k,v) ->
> maybe (HT.insert ht k v) (const $ abort k) <$> HT.lookup ht k
> return ht
> where
> xs = [1 .. 10] :: [Int]
> pairs = map (\ i -> (i, even i)) xs
> abort k = error $ "cache: duplicate key " ++ show k ++ "."
>
>
> --
> ----------------------------------------------------------------------
> Erik de Castro Lopo
> http://www.mega-nerd.com/
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/libraries/attachments/20160401/3aa81138/attachment-0001.html>
More information about the Libraries
mailing list