[Haskell-cafe] Parsing different types, same typeclass

Stephen Tetley stephen.tetley at gmail.com
Sun Nov 18 17:56:41 CET 2012


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.



More information about the Haskell-Cafe mailing list