[Haskell-cafe] ErrorT and catchError question

Adam Smyczek adam.smyczek at gmail.com
Tue Jan 15 22:54:11 EST 2008


On Jan 15, 2008, at 7:34 PM, Brandon S. Allbery KF8NH wrote:

>
> On Jan 15, 2008, at 22:05 , Adam Smyczek wrote:
>
>> Ups, resend, first response did not make into the list.
>> On Jan 14, 2008, at 9:33 PM, Brandon S. Allbery KF8NH wrote:
>>
>>>
>>> On Jan 15, 2008, at 0:28 , Adam Smyczek wrote:
>>>
>>>> It's probably a trivial question, but I cannot figure out
>>>> how to implement the catchError function in:
>>>>
>>>> instance MonadError String Shell where
>>>> 	throwError      = error . ("Shell failed: "++)
>>>> 	catchError l h = ???
>>>
>>> Take a look at Control.Exception.catch for starters.
>>
>> No, did not help and
>> going over the source code of Control.Monad.Error did not
>> help as well. Does someone have other tips for me?
>
> Perhaps you could explain what you're looking for?  Your typeclass  
> doesn't tell us anything about the semantics.

The type declaration:

newtype Loader a = Loader
   { load :: ErrorT String IO a }
   deriving (Functor, Monad, MonadIO)

instance MonadError String Loader where
   throwError = error . ("Error: " ++)
   l `catchError` h = ??? how do I implement this ???

-- Example usage

data Attribute = Attribute
   { a_name :: Name, a_value :: Value } deriving Show

-- Find a required attribute by name and throw an
-- exception it if does not exist
findRequired :: Name -> [Attribute] -> Loader Attribute
findRequired n as =
   case find (\a -> a_name a == n) as of
     Just a  -> return a
     Nothing -> throwError $ "Missing required '" ++ n
                  ++ "' attribute!"

-- I would like to use catchException for
-- findOptional and provide default value
-- if findRequired fails
findOptional :: Name -> [Attribute] -> Value -> Loader Attribute
findOptional n as defaultValue =
   catchError (findRequired n as)
              (\_ -> return $ Attribute n defaultValue)

As you probably can see on this code, I'm a haskell newbie and
open for all tips how to improve this code.

Thanks,
Adam


> -- 
> brandon s. allbery [solaris,freebsd,perl,pugs,haskell]  
> allbery at kf8nh.com
> system administrator [openafs,heimdal,too many hats]  
> allbery at ece.cmu.edu
> electrical and computer engineering, carnegie mellon university     
> KF8NH
>
>



More information about the Haskell-Cafe mailing list