[Haskell-cafe] Re: Suggestion: Syntactic sugar for Maps!

Don Stewart dons at galois.com
Thu Nov 27 16:16:51 EST 2008


bulat.ziganshin:
> Hello circ,
> 
> Thursday, November 27, 2008, 9:59:08 PM, you wrote:
> > So why not {"hello": 1, "there": 2} ?
> 
> mymap "hello:1 there:2"
> 
> where mymap implementation is left to the reader :)

Hey, well, even easier:

    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE FlexibleInstances #-}

    import Data.Map
    import Data.String
    import Text.JSON

    instance IsString (Map Int Bool) where
        fromString = fromList . read

    -- or, say, JSON syntax for assoc lists.
    {-
        fromString s = case resultToEither (decode s) of
                        Right a -> a
                        Left s  -> error s
    -}

    test :: Map Int Bool
    test = "[(7, True), (1, False)]"

    main = print test

-- Don


More information about the Haskell-Cafe mailing list