[Haskell-cafe] Re: exceptions vs. Either

MR K P SCHUPKE k.schupke at imperial.ac.uk
Sat Aug 7 07:16:03 EDT 2004


>Sounds like a job for...Type Inference! 

In Olegs post where he gave examples of how to make exceptions explicit
in type signatures:

oleg said:

> {-# OPTIONS -fglasgow-exts #-}
> {-# OPTIONS -fallow-undecidable-instances #-}
>
> module TER where
>
> class CERROR a c where
>     darn:: a -> c-> String -> b
>
> instance Show a => CERROR a c where
>     darn label _ msg = error $ "Error: " ++ (show label) ++ " " ++ msg
>   
>
> data EHead = EHead deriving Show
> data ETail = ETail deriving Show
> data EJust = EJust deriving Show
>
> myhead x@([]) = darn EHead x "head of an empty list"
> myhead (x:_) = x
>
> mytail x@([]) = darn ETail x "tail of an empty list"
> mytail (_:xs) = xs

Now, if we ask GHCi for the type of myhead, we get

        *TER> :t myhead
        myhead :: forall a. (CERROR EHead [a]) => [a] -> a

----------------------------------------------------------

As you can see you get the advantage of explicit exceptions,
but with type inference.

	Keean.


More information about the Haskell-Cafe mailing list