Monad/Functor laws violation

[NCrashed]

This crashes program:

import Haste.HPlay.View
import Control.Applicative

eitherWidget :: Widget a -> Widget b -> Widget (Either a b)
-- eitherWidget wa wb = (return . Left =<< wa) <|> (return . Right =<< wb) -- but this doesn't crash
eitherWidget wa wb = (Left <$> wa) <|> (Right <$> wb)

main = runBody $ do
    res <- eitherWidget wa wb
    case res of
        Left v -> wprint $ "Left " ++ show v
        Right v -> wprint $ "Right " ++ show v
    where
        wa :: Widget Int
        wa = wbutton 10 "Left"

        wb :: Widget Float
        wb = wbutton 42.0 "Right"

Console output:

TypeError: val is undefined

Link to example (perhaps, isn't available as heroku resets instance): http://tryplayg.herokuapp.com/try/map_bug.hs/edit

[agocorona]

I'm looking at the bug. This slightly simpler program also reproduces the error:

The problem is with fmap

data Ejm a= Ejm a deriving Show

main = runBody $ do
    res <- fmap Ejm wa
    wprint res 
    where
    wa :: Widget Int
    wa = do
     (wraw $ input ! atr "type" "button" ! atr "value" "Left") `fire` OnClick  
     return  10 

[agocorona]

I forgot to tell that an easy workaround is to include the expression within the event: for example:

 (Ejm <$>  input ! atr "type" "button" ! atr "value" "Left" ) `fire` OnClick

[agocorona]

Solved in the last push, and in the docker image. Thanks

[NCrashed]

Thanks!