
Oh! Right, sorry about that.
On Sun, Apr 13, 2014 at 12:01 PM, Oliver Charles
You have only pattern matched the empty list and a two element list. Perhaps you meant (x : _) to match at least one element?
- ocharles On 13 Apr 2014 10:58, "Konstantine Rybnikov"
wrote: Continuing playing with OverloadedLists and GHC 7.8.2. For this code:
``` {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}
import Data.Map import Data.Text import GHC.Exts
instance (Ord k) => IsList (Map k v) where type Item (Map k v) = (k,v) fromList = Data.Map.fromList toList = Data.Map.toList
main :: IO () main = do let m = [("foo", 1), ("bar", 2)] :: Map Text Int putStrLn "My map looks like this:" case m of [] -> putStrLn "impossible!" [x,_] -> putStrLn $ "ok, some random elem is: " ++ show x
print m ```
I have this output from compiler:
``` root@b575c8a9c84b:~/overloaded_lists# cabal build --ghc-options="-fforce-recomp" Building overloaded-lists-0.1.0.0... Preprocessing executable 'overloaded-lists' for overloaded-lists-0.1.0.0... [1 of 1] Compiling Main ( src/Main.hs, dist/build/overloaded-lists/overloaded-lists-tmp/Main.o )
src/Main.hs:19:5: Warning: Pattern match(es) are non-exhaustive In a case alternative: Patterns not matched: _
src/Main.hs:9:10: Warning: Orphan instance: instance Ord k => IsList (Map k v) [1 of 1] Compiling Main ( src/Main.hs, dist/build/overloaded-lists/overloaded-lists-tmp/Main.o )
src/Main.hs:19:5: Warning: Pattern match(es) are non-exhaustive In a case alternative: Patterns not matched: _
src/Main.hs:9:10: Warning: Orphan instance: instance Ord k => IsList (Map k v) Linking dist/build/overloaded-lists/overloaded-lists ... ```
Couple things:
1. It shows same warnings two times. Is this a bug? 2. It doesn't seem to be that warning that pattern "_" wasn't matched should be there. Should I also create a bug report?
Thank you!
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe