[Haskell-cafe] Parsing different types, same typeclass

Jose A. Lopes jose.lopes at ist.utl.pt
Sun Nov 18 18:23:23 CET 2012


Thanks Stephen. I will try this!

On 18-11-2012 17:56, Stephen Tetley wrote:
> With existentials an "extesible" version might look like this:
>
>> {-# LANGUAGE ExistentialQuantification #-}
>> {-# LANGUAGE ScopedTypeVariables #-}
>
> ... class Action and datatypes A and B the same as before ...
>
>
>> -- some new ones...
>> data C = C Int
>>           deriving (Read, Show)
>
>> instance Action C where
>>       run (C n) = n
>
>> data D = D Int
>>           deriving (Read, Show)
>> instance Action D where
>>       run (D n) = n
>
> The important one:
>
>> data PolyA = forall a. Action a => PolyA a
>
>> parseAction :: String -> PolyA
>> parseAction str
>>       | "(A " `isPrefixOf` str = PolyA $ (read :: String -> A) str
>>       | "(B " `isPrefixOf` str = PolyA $ (read :: String -> B) str
>>
>>       -- can add new cases
>>       | "(C " `isPrefixOf` str = PolyA $ (read :: String -> C) str
>>       | "(D " `isPrefixOf` str = PolyA $ (read :: String -> D) str
>
> This is "extensible" to some degree as you can add new cases of
> "different" types, but all you can do with these different types is
> run them to make an Int, so it is equivalent to the second version I
> gave previously:
>
>> parseAction :: String -> Int
>> parseAction str
>>      | "(A " `isPrefixOf` str = run $ (read str :: A)
>>      | "(B " `isPrefixOf` str = run $ (read str :: B)
>>      | "(C " `isPrefixOf` str = run $ (read str :: C)
>>      | "(D " `isPrefixOf` str = run $ (read str :: D)
> i.e instead of using an existential type to hold something polymorphic
> that can be run to produce an Int, just call run at the point of use
> making an Int.

-- 
José António Branquinho de Oliveira Lopes
Instituto Superior Técnico
Technical University of Lisbon




More information about the Haskell-Cafe mailing list