[Haskell-cafe] fromInteger for Lists
Ryan Ingram
ryani.spam at gmail.com
Fri May 1 19:24:41 EDT 2009
I wish for a language extension "OverloadedLiterals" that includes all of these:
1 => fromInteger 1
"hello" => fromString "hello"
['a', 'b', 'c'] => cons 'a' (cons 'b' (cons 'c' nil))
[ ord x | x <- ['a', 'b', 'c'], ok x ]
=>
cons 'a' (cons 'b' (cons 'c' nil)) >>= \x -> guard (ok x) >> return (ord x)
Maybe something similar for pair notation too!
GHC already has:
class Num a where ... fromInteger :: Integer -> a
class IsString where fromString :: String -> a
What is the right interface for cons/nil? John's fromList is one
suggestion. I'd suggest either:
class ListLike c where
type Element c
fromList :: [Element c] -> c
or
class Nil c where
nil :: c
class Container c e where
cons :: e -> c -> c
This would allow something like:
import qualified Data.Map as M
data KeyVal k v = k :> v
instance Ord k => ListLike (M.Map k v) where
type Element (M.Map k v) = k :> v
fromList = foldr insertElem M.empty where
insertElem (k :> v) m = M.insert k v m
which lets you have "first-class" looking maps:
M.lookup "Bob" ["Bob" :> 1, "Alice" :> 2, "John" :> 15]
-- ryan
On Fri, May 1, 2009 at 4:06 PM, John Dorsey <haskell at colquitt.org> wrote:
> Paul,
>
>> There's nothing better than making a data type an instance of Num. In
>> particular, fromInteger is a joy. But how about lists?
>
> Do you mean something like Blargh below, only useful?
>
> John
>
>
> dorsey at elwood:~/src/scratch$ cat list.hs
>
> class Blargh f where
> fromList :: [a] -> f a
>
> data Foo a = Foo [a] deriving (Show)
> data Bar a = Bar [a] deriving (Show)
>
> instance Blargh Foo where
> fromList = Foo
>
> instance Blargh Bar where
> fromList l = Bar (reverse l)
>
> dorsey at elwood:~/src/scratch$ ghci list.hs
> GHCi, version 6.8.3: http://www.haskell.org/ghc/ :? for help
> Loading package base ... linking ... done.
> [1 of 1] Compiling Main ( list.hs, interpreted )
> Ok, modules loaded: Main.
> *Main> fromList [1,2,3] :: Foo Int
> Foo [1,2,3]
> *Main> fromList [1,2,3] :: Bar Int
> Bar [3,2,1]
> *Main>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
More information about the Haskell-Cafe
mailing list