How does EitherT work? - error-handling

I spend half of my day trying to figure out how to use EitherT as a way to deal with errors in my code.
I have defined a transformer stack like this.
-- Stuff Monad
data StuffConfig = StuffConfig {
appId :: T.Text,
appSecret :: T.Text
}
data StuffState = StuffState {
stateToken :: Maybe Token,
stateTime :: POSIXTime
}
newtype Stuff a = Stuff {
runStuff :: (ReaderT StuffConfig (StateT StuffState (EitherT T.Text IO))) a
} deriving (Monad, Functor, Applicative,
MonadIO,
MonadReader StuffConfig,
MonadState StuffState
)
askStuff :: StuffConfig -> Stuff a -> IO (Either T.Text a)
askStuff config a = do
t <- getPOSIXTime
runEitherT (evalStateT (runReaderT (runStuff a) config) (StuffState Nothing t))
This works quite well as long as i only use the ReaderT and StateT functions. I am under the impression that now i should be able to write something like this:
faultyFunction :: String -> Stuff String
faultyFunction s = do
when s == "left" $ left "breaking out"
"right"
More important is capturing Either return values which should be possible with hoistEither from the errors package:
faultyLookup :: Map -> String -> Stuff String
faultyLookup m k = do
hoistEither $ lookup k m
I read the real world haskell chapter on monad transformers and fiddled around with lift. But I can't get anything to typecheck.

The reason you can't just use the left and hoistEither functions directly is that unlike StateT and ReaderT from the mtl package, the either package doesn't provide a typeclass similar to MonadReader or MonadState.
The aforementioned typeclasses take care of lifting in the monad stack transparently, but for EitherT, you have to do the lifting yourself (or write a MonadEither typeclass similar to MonadReader et al).
faultyFunction :: String -> Stuff String
faultyFunction s = do
when (s == "left") $ Stuff $ lift $ lift $ left "breaking out"
return "right"
First you need to apply the Stuff wrapper, then lift over the ReaderT transformer and then lift again over the StateT transformer.
You probably want to write utility functions for yourself such as
stuffLeft :: T.Text -> Stuff a
stuffLeft = Stuff . lift . lift . left
Then you can simply use it like this:
faultyFunction :: String -> Stuff String
faultyFunction s = do
when (s == "left") $ stuffLeft "breaking out"
return "right"
Alternatively, you could use Control.Monad.Error from mtl, if you define an Error instance for Text.
instance Error T.Text where
strMsg = T.pack
Now you can change the definition of Stuff implement left and hoistEither like this:
newtype Stuff a = Stuff {
runStuff :: (ReaderT StuffConfig (StateT StuffState (ErrorT T.Text IO))) a
} deriving (Monad, Functor, Applicative,
MonadIO,
MonadReader StuffConfig,
MonadState StuffState,
MonadError T.Text
)
left :: T.Text -> Stuff a
left = throwError
hoistEither :: Either T.Text a -> Stuff a
hoistEither = Stuff . lift . lift . ErrorT . return
With this your original faultyFunction type-checks without any manual lifting.
You can also write generic implementations for left and hoistEither which work for any instance of MonadError (using either from Data.Either):
left :: MonadError e m => e -> m a
left = throwError
hoistEither :: MonadError e m => Either e a -> m a
hoistEither = either throwError return

Just to add to shang's answer: MonadError is basically the corresponding type class to EitherT. You can add its instance for EitherT (for some reason it's commented out in the either library):
import Control.Monad.Trans.Either
hiding (left, right, hoistEither)
instance Monad m => MonadError e (EitherT e m) where
throwError = EitherT . return . Left
EitherT m `catchError` h = EitherT $ m >>= \a -> case a of
Left l -> runEitherT (h l)
Right r -> return (Right r)
Then, define your own methods that are generalized to MonadError:
left :: MonadError e m => e -> m a
left = throwError
{-# INLINE left #-}
right :: MonadError e m => a -> m a
right = return
{-# INLINE right #-}
hoistEither :: MonadError e m => Either e a -> m a
hoistEither (Left a) = throwError a
hoistEither (Right e) = return e
{-# INLINE hoistEither #-}
Now you can do things like:
import qualified Data.Map as Map
newtype Stuff a = Stuff {
runStuff :: (ReaderT Int (StateT Char (EitherT T.Text IO))) a
} deriving (Monad, Functor,
MonadReader Int,
MonadError T.Text, -- <--- MonadError instance
MonadState Char
)
faultyLookup :: (Ord k) => Map.Map k a -> k -> Stuff a
faultyLookup m k =
maybe (left $ T.pack "Lookup error") right $ Map.lookup k m
or generalize it to
faultyLookup :: (MonadError T.Text m, Ord k) => Map.Map k a -> k -> m a
faultyLookup m k =
maybe (left $ T.pack "Lookup error") right $ Map.lookup k m

Related

How can I quickly select an option from a dropdown using Haskell and webdriver?

I have a site with a <select> that has more than 100 <option>s in it, one for every country in the world. My test needs to select one. My current solution - below - takes around 2.5 seconds. I'd like it to be much faster.
findChildrenByLabel :: (WD.WebDriver m, MonadIO m) =>
Text -> Text -> m [WD.Element]
findChildrenByLabel label tagName = do
parentEl <- findFieldByLabel label
WD.findElemsFrom parentEl $ WD.ByTag tagName
findChildByLabelF :: (WD.WebDriver m, MonadIO m) =>
Text -> Text -> (WD.Element -> m Bool) -> m WD.Element
findChildByLabelF label tagName f = do
children <- findChildrenByLabel label tagName
child <- filterM f children
liftIO $ child `shouldSatisfy` ((==1) . length)
return (headEx child)
selectDropdownByLabel :: (WD.WebDriver m, MonadIO m) => Text -> Text -> m ()
selectDropdownByLabel label optionName = do
targetOption <- findChildByLabelF
label "option" (\el -> (== optionName) <$> WD.getText el)
WD.click targetOption
I found this SO answer in Java, but there doesn't seem to be anything like Selenium.Support or SelectByText for Haskell.
Based on danidiaz's answer, I wrote this:
findFieldByLabel :: (WD.WebDriver m, MonadIO m) => Text -> m WD.Element
findFieldByLabel str = do
labels :: [WD.Element] <- WD.findElems $ WD.ByXPath $
"//label[text() = \"" <> str <> "\"]"
els <- catMaybes <$> mapM (`WD.attr` "for") labels
liftIO $ els `shouldSatisfy` ((==1) . length)
WD.findElem $ WD.ById $ headEx els
selectDropdownByLabel :: (WD.WebDriver m, MonadIO m) => Text -> Text -> m ()
selectDropdownByLabel label optionName = do
field <- findFieldByLabel label
targetOptions <- WD.findElemsFrom field $ WD.ByXPath $
"option[text() = \"" <> optionName <> "\"]"
liftIO $ targetOptions `shouldSatisfy` ((==1) . length)
WD.click $ headEx targetOptions
I use it like this:
selectDropdownByLabel "Country of residence" "United States"
The original solution took around 2.5 seconds, this is around 0.16. Big improvement, thanks danidiaz!

SML Option Monad (bind operator not working)

I want to implement Option Monad in SML, so I can use them the same way they can be used in haskell. What I did, does not work.
infix 1 >>=
signature MONAD =
sig
type 'a m
val return : 'a -> 'a m
val >>= : 'a m * ('a -> 'b m) -> 'b m
end;
structure OptionM : MONAD =
struct
type 'a m = 'a option
val return = SOME
fun x >>= k = Option.mapPartial k x
end;
val x = OptionM.return 3;
x (OptionM.>>=) (fn y => NONE);
Result:
stdIn:141.1-141.31 Error: operator is not a function [tycon mismatch]
operator: int OptionM.m
in expression:
x OptionM.>>=
What can I do to make the last line work?
Unlike in Haskell, qualified infix operators (such as A.+ or Option.>>=) are not infix in SML. You need to use them unqualified, e.g. by either opening the module or by rebinding it locally.
Btw, you probably want to define >>= as right-associative, i.e., use infixr.
Also, SML has stricter precedence rules than Haskell. That will make it somewhat more tedious to chain several uses of >>= with lambdas, because you have to parenthesise each fn on the right:
foo >>= (fn x => bar >>= (fn y => baz >>= (fn z => boo)))

Is it possible to make GHC optimize (deforest) generic functions such as catamorphisms?

I really like the idea of working with catamorphisms/anamorphisms in a generic way, but it seems to me it has a significant performance drawback:
Suppose we want to work with a tree structure in the categorical way - to describe different folding using a generic catamorphism function:
newtype Fix f = Fix { unfix :: f (Fix f) }
data TreeT r = Leaf | Tree r r
instance Functor TreeT where
fmap f Leaf = Leaf
fmap f (Tree l r) = Tree (f l) (f r)
type Tree = Fix TreeT
catam :: (Functor f) => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix
Now we can write functions like:
depth1 :: Tree -> Int
depth1 = catam g
where
g Leaf = 0
g (Tree l r) = max l r
Unfortunately, this approach has a significant drawback: During the computation, new instances of TreeT Int are created at every level in fmap just to be immediately consumed by g. Compared to the classical definition
depth2 :: Tree -> Int
depth2 (Fix Leaf) = 0
depth2 (Fix (Tree l r)) = max (depth1 l) (depth1 r)
our depth1 will be always slower making unnecessary strain on the GC. One solution would be to use hylomorphisms and combine creation and folding trees together. But often we don't want to do that, we may want a tree to be created on one place and then passed somewhere else to be folded later. Or, to be folder several times with different catamorphisms.
Is there a way to make GHC optimize depth1? Something like inlining catam g and then fusing/deforesting g . fmap ... inside?
I believe I found an answer. I remembered reading Why does GHC make fix so confounding? and that suggested me a solution.
The problem with the former definition of catam is that it is recursive, and so any attempt to INLINE it is ignored. Compiling the original version with -ddump-simpl -ddump-to-file and reading the core:
Main.depth1 = Main.catam_$scatam # GHC.Types.Int Main.depth3
Main.depth3 =
\ (ds_dyI :: Main.TreeT GHC.Types.Int) ->
case ds_dyI of _ {
Main.Leaf -> Main.depth4;
Main.Tree l_aah r_aai -> GHC.Classes.$fOrdInt_$cmax l_aah r_aai
}
Main.depth4 = GHC.Types.I# 0
Rec {
Main.catam_$scatam =
\ (# a_ajB)
(eta_B1 :: Main.TreeT a_ajB -> a_ajB)
(eta1_X2 :: Main.Fix Main.TreeT) ->
eta_B1
(case eta1_X2
`cast` (Main.NTCo:Fix <Main.TreeT>
:: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
of _ {
Main.Leaf -> Main.Leaf # a_ajB;
Main.Tree l_aan r_aao ->
Main.Tree
# a_ajB
(Main.catam_$scatam # a_ajB eta_B1 l_aan)
(Main.catam_$scatam # a_ajB eta_B1 r_aao)
})
end Rec }
is clearly worse (constructor creation/elimination in catam_$scatam, more function calls) compared to
Main.depth2 =
\ (w_s1Rz :: Main.Tree) ->
case Main.$wdepth2 w_s1Rz of ww_s1RC { __DEFAULT ->
GHC.Types.I# ww_s1RC
}
Rec {
Main.$wdepth2 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S]
Main.$wdepth2 =
\ (w_s1Rz :: Main.Tree) ->
case w_s1Rz
`cast` (Main.NTCo:Fix <Main.TreeT>
:: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
of _ {
Main.Leaf -> 0;
Main.Tree l_aaj r_aak ->
case Main.$wdepth2 l_aaj of ww_s1RC { __DEFAULT ->
case Main.$wdepth2 r_aak of ww1_X1Sh { __DEFAULT ->
case GHC.Prim.<=# ww_s1RC ww1_X1Sh of _ {
GHC.Types.False -> ww_s1RC;
GHC.Types.True -> ww1_X1Sh
}
}
}
}
end Rec }
But if we define catam as
{-# INLINE catam #-}
catam :: (Functor f) => (f a -> a) -> (Fix f -> a)
catam f = let u = f . fmap u . unfix
in u
then it is no longer recursive, only u inside is. This way GHC inlines catam in the definition of depth1 and fuses fmap with depth1's g - just what we want:
Main.depth1 =
\ (w_s1RJ :: Main.Tree) ->
case Main.$wdepth1 w_s1RJ of ww_s1RM { __DEFAULT ->
GHC.Types.I# ww_s1RM
}
Rec {
Main.$wdepth1 [Occ=LoopBreaker] :: Main.Tree -> GHC.Prim.Int#
[GblId, Arity=1, Caf=NoCafRefs, Str=DmdType S]
Main.$wdepth1 =
\ (w_s1RJ :: Main.Tree) ->
case w_s1RJ
`cast` (Main.NTCo:Fix <Main.TreeT>
:: Main.Fix Main.TreeT ~# Main.TreeT (Main.Fix Main.TreeT))
of _ {
Main.Leaf -> 0;
Main.Tree l_aar r_aas ->
case Main.$wdepth1 l_aar of ww_s1RM { __DEFAULT ->
case Main.$wdepth1 r_aas of ww1_X1So { __DEFAULT ->
case GHC.Prim.<=# ww_s1RM ww1_X1So of _ {
GHC.Types.False -> ww_s1RM;
GHC.Types.True -> ww1_X1So
}
}
}
}
end Rec }
which is now just the same as the dump of depth2.

GHC rejects ST monad code as unable to unify type variables?

I wrote the following function:
(.>=.) :: Num a => STRef s a -> a -> Bool
r .>=. x = runST $ do
v <- readSTRef r
return $ v >= x
but when I tried to compile I got the following error:
Could not deduce (s ~ s1)
from the context (Num a)
bound by the type signature for
.>=. :: Num a => STRef s a -> a -> Bool
at test.hs:(27,1)-(29,16)
`s' is a rigid type variable bound by
the type signature for .>=. :: Num a => STRef s a -> a -> Bool
at test.hs:27:1
`s1' is a rigid type variable bound by
a type expected by the context: ST s1 Bool at test.hs:27:12
Expected type: STRef s1 a
Actual type: STRef s a
In the first argument of `readSTRef', namely `r'
In a stmt of a 'do' expression: v <- readSTRef r
Can anyone help?
This is exactly as intended. An STRef is only valid in one run of runST. And you try to put an external STRef into a new run of runST. That is not valid. That would allow arbitrary side-effects in pure code.
So, what you try is impossible to achieve. By design!
You need to stay within the ST context:
(.>=.) :: Ord a => STRef s a -> a -> ST s Bool
r .>=. x = do
v <- readSTRef r
return $ v >= x
(And as hammar points out, to use >= you need the Ord typeclass, which Num doesn't provide.)

How would I translate a Haskell type class into F#?

I'm trying to translate the Haskell core library's Arrows into F# (I think it's a good exercise to understanding Arrows and F# better, and I might be able to use them in a project I'm working on.) However, a direct translation isn't possible due to the difference in paradigms. Haskell uses type-classes to express this stuff, but I'm not sure what F# constructs best map the functionality of type-classes with the idioms of F#. I have a few thoughts, but figured it best to bring it up here and see what was considered to be the closest in functionality.
For the tl;dr crowd: How do I translate type-classes (a Haskell idiom) into F# idiomatic code?
For those accepting of my long explanation:
This code from the Haskell standard lib is an example of what I'm trying to translate:
class Category cat where
id :: cat a a
comp :: cat a b -> cat b c -> cat a c
class Category a => Arrow a where
arr :: (b -> c) -> a b c
first :: a b c -> a (b,d) (c,d)
instance Category (->) where
id f = f
instance Arrow (->) where
arr f = f
first f = f *** id
Attempt 1: Modules, Simple Types, Let Bindings
My first shot at this was to simply map things over directly using Modules for organization, like:
type Arrow<'a,'b> = Arrow of ('a -> 'b)
let arr f = Arrow f
let first f = //some code that does the first op
That works, but it loses out on polymorphism, since I don't implement Categories and can't easily implement more specialized Arrows.
Attempt 1a: Refining using Signatures and types
One way to correct some issues with Attempt 1 is to use a .fsi file to define the methods (so the types enforce easier) and to use some simple type tweaks to specialize.
type ListArrow<'a,'b> = Arrow<['a],['b]>
//or
type ListArrow<'a,'b> = LA of Arrow<['a],['b]>
But the fsi file can't be reused (to enforce the types of the let bound functions) for other implementations, and the type renaming/encapsulating stuff is tricky.
Attempt 2: Object models and interfaces
Rationalizing that F# is built to be OO also, maybe a type hierarchy is the right way to do this.
type IArrow<'a,'b> =
abstract member comp : IArrow<'b,'c> -> IArrow<'a,'c>
type Arrow<'a,'b>(func:'a->'b) =
interface IArrow<'a,'b> with
member this.comp = //fun code involving "Arrow (fun x-> workOn x) :> IArrow"
Aside from how much of a pain it can be to get what should be static methods (like comp and other operators) to act like instance methods, there's also the need to explicitly upcast the results. I'm also not sure that this methodology is still capturing the full expressiveness of type-class polymorphism. It also makes it hard to use things that MUST be static methods.
Attempt 2a: Refining using type extensions
So one more potential refinement is to declare the interfaces as bare as possible, then use extension methods to add functionality to all implementing types.
type IArrow<'a,'b> with
static member (&&&) f = //code to do the fanout operation
Ah, but this locks me into using one method for all types of IArrow. If I wanted a slightly different (&&&) for ListArrows, what can I do? I haven't tried this method yet, but I would guess I can shadow the (&&&), or at least provide a more specialized version, but I feel like I can't enforce the use of the correct variant.
Help me
So what am I supposed to do here? I feel like OO should be powerful enough to replace type-classes, but I can't seem to figure out how to make that happen in F#. Were any of my attempts close? Are any of them "as good as it gets" and that'll have to be good enough?
My brief answer is:
OO is not powerful enough to replace type classes.
The most straightforward translation is to pass a dictionary of operations, as in one typical typeclass implementation. That is if typeclass Foo defines three methods, then define a class/record type named Foo, and then change functions of
Foo a => yadda -> yadda -> yadda
to functions like
Foo -> yadda -> yadda -> yadda
and at each call site you know the concrete 'instance' to pass based on the type at the call-site.
Here's a short example of what I mean:
// typeclass
type Showable<'a> = { show : 'a -> unit; showPretty : 'a -> unit } //'
// instances
let IntShowable =
{ show = printfn "%d"; showPretty = (fun i -> printfn "pretty %d" i) }
let StringShowable =
{ show = printfn "%s"; showPretty = (fun s -> printfn "<<%s>>" s) }
// function using typeclass constraint
// Showable a => [a] -> ()
let ShowAllPretty (s:Showable<'a>) l = //'
l |> List.iter s.showPretty
// callsites
ShowAllPretty IntShowable [1;2;3]
ShowAllPretty StringShowable ["foo";"bar"]
See also
https://web.archive.org/web/20081017141728/http://blog.matthewdoig.com/?p=112
Here's the approach I use to simulate Typeclasses (from http://code.google.com/p/fsharp-typeclasses/ ).
In your case, for Arrows could be something like this:
let inline i2 (a:^a,b:^b ) =
((^a or ^b ) : (static member instance: ^a* ^b -> _) (a,b ))
let inline i3 (a:^a,b:^b,c:^c) =
((^a or ^b or ^c) : (static member instance: ^a* ^b* ^c -> _) (a,b,c))
type T = T with
static member inline instance (a:'a ) =
fun x -> i2(a , Unchecked.defaultof<'r>) x :'r
static member inline instance (a:'a, b:'b) =
fun x -> i3(a, b, Unchecked.defaultof<'r>) x :'r
type Return = Return with
static member instance (_Monad:Return, _:option<'a>) = fun x -> Some x
static member instance (_Monad:Return, _:list<'a> ) = fun x -> [x]
static member instance (_Monad:Return, _: 'r -> 'a ) = fun x _ -> x
let inline return' x = T.instance Return x
type Bind = Bind with
static member instance (_Monad:Bind, x:option<_>, _:option<'b>) = fun f ->
Option.bind f x
static member instance (_Monad:Bind, x:list<_> , _:list<'b> ) = fun f ->
List.collect f x
static member instance (_Monad:Bind, f:'r->'a, _:'r->'b) = fun k r -> k (f r) r
let inline (>>=) x (f:_->'R) : 'R = T.instance (Bind, x) f
let inline (>=>) f g x = f x >>= g
type Kleisli<'a, 'm> = Kleisli of ('a -> 'm)
let runKleisli (Kleisli f) = f
type Id = Id with
static member instance (_Category:Id, _: 'r -> 'r ) = fun () -> id
static member inline instance (_Category:Id, _:Kleisli<'a,'b>) = fun () ->
Kleisli return'
let inline id'() = T.instance Id ()
type Comp = Comp with
static member instance (_Category:Comp, f, _) = (<<) f
static member inline instance (_Category:Comp, Kleisli f, _) =
fun (Kleisli g) -> Kleisli (g >=> f)
let inline (<<<) f g = T.instance (Comp, f) g
let inline (>>>) g f = T.instance (Comp, f) g
type Arr = Arr with
static member instance (_Arrow:Arr, _: _ -> _) = fun (f:_->_) -> f
static member inline instance (_Arrow:Arr, _:Kleisli<_,_>) =
fun f -> Kleisli (return' <<< f)
let inline arr f = T.instance Arr f
type First = First with
static member instance (_Arrow:First, f, _: 'a -> 'b) =
fun () (x,y) -> (f x, y)
static member inline instance (_Arrow:First, Kleisli f, _:Kleisli<_,_>) =
fun () -> Kleisli (fun (b,d) -> f b >>= fun c -> return' (c,d))
let inline first f = T.instance (First, f) ()
let inline second f = let swap (x,y) = (y,x) in arr swap >>> first f >>> arr swap
let inline ( *** ) f g = first f >>> second g
let inline ( &&& ) f g = arr (fun b -> (b,b)) >>> f *** g
Usage:
> let f = Kleisli (fun y -> [y;y*2;y*3]) <<< Kleisli ( fun x -> [ x + 3 ; x * 2 ] ) ;;
val f : Kleisli<int,int list> = Kleisli <fun:f#4-14>
> runKleisli f <| 5 ;;
val it : int list = [8; 16; 24; 10; 20; 30]
> (arr (fun y -> [y;y*2;y*3])) 3 ;;
val it : int list = [3; 6; 9]
> let (x:option<_>) = runKleisli (arr (fun y -> [y;y*2;y*3])) 2 ;;
val x : int list option = Some [2; 4; 6]
> ( (*) 100) *** ((+) 9) <| (5,10) ;;
val it : int * int = (500, 19)
> ( (*) 100) &&& ((+) 9) <| 5 ;;
val it : int * int = (500, 14)
> let x:List<_> = (runKleisli (id'())) 5 ;;
val x : List<int> = [5]
Note: use id'() instead of id
Update: you need F# 3.0 to compile this code, otherwise here's the F# 2.0 version.
And here's a detailed explanation of this technique which is type-safe, extensible and as you can see works even with some Higher Kind Typeclasses.