[Haskell-cafe] Monadic function fails as Nothing in Maybe context but as Exception in Either context.
Jeffrey Brown
jeffbrown.the at gmail.com
Tue Dec 1 02:18:29 UTC 2015
Oleg's suggestion works! I just had to add these two lines in order to use
it:
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Except -- mtl library
Thanks, everybody!
On Mon, Nov 30, 2015 at 2:38 PM, Oleg Grenrus <oleg.grenrus at iki.fi> wrote:
>
> On 01 Dec 2015, at 00:34, Oleg Grenrus <oleg.grenrus at iki.fi> wrote:
>
> Hi, Jeffrey
>
> in short: `fail` of `Either e` throws an exception (i.e. is not overriden,
> default implementation is `fail s = error s`) [1, 2]
>
> For `Maybe`, fail is defined as `fail _ = Nothing`; which is good default.
> [3]
>
> You probably want to use for example `throwError from `mtl` package [4]:
>
>
> I haven’t still tested it, but less wrong context is `MonadError String m`:
>
> gelemM :: (MonadError String m) => MyGraph -> Node -> m ()
> gelemM g n = if gelem n g -- FGL's gelem function returns
> then return () -- True if the node is in the
> graph
> else throwError "Node not in Graph" -- False otherwise
>
>
> [1]
> https://hackage.haskell.org/package/base-4.8.1.0/docs/src/Data.Either.html#line-137
> [2]
> https://hackage.haskell.org/package/base-4.8.1.0/docs/src/GHC.Base.html#Monad
> [3]
> https://hackage.haskell.org/package/base-4.8.1.0/docs/src/GHC.Base.html#line-642
> [4]
> http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#v:throwError
>
> - Oleg
>
> On 01 Dec 2015, at 00:25, Jeffrey Brown <jeffbrown.the at gmail.com> wrote:
>
> I've written a monadic function which in a Maybe context produces a
> Nothing when it fails (as intended), but in an Either context produces an
> Exception rather than a Left.
>
> Here's a tiny demonstration. "tinyGraph" below has one Node, 0, with the
> label "dog". If I try to change the label at Node 0 to "cat", it works. If
> I try to change the label at Node 1 to "cat", it fails, because Node 1 is
> not in the graph.
>
> type MyGraph = Gr String String
>
> tinyGraph = mkGraph [(0, "dog")] [] :: MyGraph
>
> maybeSucceed = replaceStringAtNodeM tinyGraph 0 "cat" :: Maybe MyGraph
> -- == Just (mkGraph [(0,"cat")] [])
> maybeFail = replaceStringAtNodeM tinyGraph 1 "cat" :: Maybe MyGraph
> -- == Nothing
>
> eitherSucceed = replaceStringAtNodeM tinyGraph 0 "cat" :: Either
> String MyGraph
> -- == Right (mkGraph [(0,"cat")] [])
> eitherFail = replaceStringAtNodeM tinyGraph 1 "cat" :: Either String
> MyGraph
> -- *** Exception: Node not in Graph
>
> Here's the code:
>
> import Data.Graph.Inductive -- FGL, the Functional Graph Library
>
> gelemM :: (Monad m) => MyGraph -> Node -> m ()
> gelemM g n = if gelem n g -- FGL's gelem function returns
> then return () -- True if the node is in the graph
> else fail "Node not in Graph" -- False otherwise
>
> replaceStringAtNode :: MyGraph -> Node -> String -> MyGraph
> replaceStringAtNode g n e = let (Just (a,b,c,d),g') = match n g
> in (a,b,e,d) & g'
>
> replaceStringAtNodeM :: (Monad m) => MyGraph -> Node -> String -> m
> MyGraph
> replaceStringAtNodeM g n s = do
> gelemM g n
> return $ replaceStringAtNode g n s
> -- if evaluated, the pattern match in replaceStringAtNode must
> succeed,
> -- because gelemM catches the case where n is not in the graph
>
> [1]
> https://github.com/JeffreyBenjaminBrown/digraphs-with-text/blob/master/test/monad_fail_problems.hs
>
>
> --
> Jeffrey Benjamin Brown
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
>
>
--
Jeffrey Benjamin Brown
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20151130/df69ebce/attachment.html>
More information about the Haskell-Cafe
mailing list