Validation with effects

Help
#1

Hello everybody! I would like to run some validations depending on previous computations and fail at the first error. Here is a made up example:

getENumber :: Effect (Maybe Int)
getENumber = pure (Just 15)

toEither :: forall a. String -> Maybe a -> Either String a
toEither errorMessage Nothing = Left errorMessage
toEither errorMessage (Just x) = Right x

greater10 :: String -> Int -> (Either String Int)
greater10 msg n
  | n > 10 = Right n
greater10 msg n = Left msg

add10 :: String -> Int -> Either String Int
add10 msg n
  | n < 30 = Right (n + 10)
add10 msg n = Left msg

addE10 :: String -> Int -> Effect (Either String Int)
addE10 msg n
  | n < 50 = pure $ Right (n + 10)
addE10 msg n = pure $ Left msg

pipe :: Effect (Either String Int)
pipe =
  getENumber 
    >>= toEither "no number" --Error
    >>= greater10 "first check"
    >>= add10 "failed at +10"
    >>= add10 "failed at +20"
    >>= add10 "failed at +30"
    >>= addE10 "failed at +40"
    >>= add10 "failed at +50"
    >>= greater10 "last check"

In chapter 8 address was lifted to work with Maybe. How can lift these functions properly to work with Either?

#2

You probably don’t want to hear this, but I think you need monad transformers to do what you want. Personally, I really liked the book’s description of monad transformers in chapter 11. You’re trying to get two monads together so that >>= will both combine effects via Effect, and propagate failures via Either, and monad transformers are the way to combine two monads together like that. Without actually trying this with a compiler, I would think you could do something like:

pipe :: Effect (Either String Int)
pipe = runExceptT go
  where
    go = 
      ExceptT (getENumber <#> toEither "no number")
        >>= (greater10 "first check" >>> except)
        >>= (add10 "failed at +10" >>> except)
        >>= (add10 "failed at +20" >>> except)
        >>= (add10 "failed at +30" >>> except)
        >>= (addE10 "failed at +40" >>> ExceptT)
        >>= (add10 "failed at +50" >>> except)
        >>= (greater10 "last check" >>> except)

So ExceptT String Effect a is your combined monad. You can turn an Either String a into an ExceptT String Effect a with the except function. You can turn an Effect (Either String a) into an ExceptT String Effect a with the ExceptT constructor. (You can also turn an Effect a into an ExceptT String Effect a with the lift function). Then runExceptT turns it back from ExceptT String Effect a to Effect (Either String a)

#3

If you can reorganize your code so that calls producing native Effects are better isolated from your pure functions (rather than being interleaved), then you can likely avoid monad transformers while still having a pretty clean solution. This might not always be possible though. Out of curiosity, what are the getENumber and addE10 calls in your actual application?

Note, you can use note instead of your custom toEither.

Edit: For reference, here’s a version without monad transformers. Doesn’t seem as nice to read or maintain.

pipe2 =
  getENumber
  >>= (\x -> case
    note "no number" x
    >>= greater10 "first check"
    >>= add10 "failed at +10"
    >>= add10 "failed at +20"
    >>= add10 "failed at +30"
    of
    Left msg -> pure $ Left msg
    Right n -> addE10 "failed at +40" n
  )
  <#> (\x -> x
    >>= add10 "failed at +50"
    >>= greater10 "last check"
  )

Possibly easier to follow with do notation, helper functions, and intermediate values:

pureOps1 :: Either String Int -> Either String Int
pureOps1 x = x
  >>= greater10 "first check"
  >>= add10 "failed at +10"
  >>= add10 "failed at +20"
  >>= add10 "failed at +30"

pureOps2 :: Either String Int -> Either String Int
pureOps2 x = x
  >>= add10 "failed at +50"
  >>= greater10 "last check"

-- Can this be generalized to work with any Bifunctor (instead of only Either)?
rmapEffect :: forall a b c f. Applicative f =>
  (b -> f (Either a c)) -> Either a b -> f (Either a c)
rmapEffect f = case _ of
  Left e -> pure $ Left e
  Right v -> f v

pipe3 :: Effect (Either String Int)
pipe3 = do
  num <- getENumber
  let r1 = pureOps1 $ note "no number" num
  r2 <- rmapEffect (addE10 "failed at +40") r1
  pure $ pureOps2 r2
#4

Thank you both very much!
My actual application is making CRUD calls with Express like

getUser :: Pool -> Handler
getUser pool =
  getRouteParam "id"
    >>= case _ of
        Nothing -> respond 422 { error: "User ID is required" }
        Just sUserId -> case fromString sUserId of
          Nothing -> respond 422 { error: "User ID must be an integer: " <> sUserId }
          Just userId ->
            liftAff (P.findUser pool userId)
              >>= case _ of
                  Nothing -> respond 404 { error: "User not found with id: " <> sUserId }
                  Just user -> respond 200 (encode user)

I fancy top down, no cases but I am a little fuzzy about including encode and using sUserId in error messages.

respondEither :: forall a. Either a a -> Handler
respondEither (Left s) = respond 404 s
respondEither (Right s) = respond 200 s

goUser :: Pool -> forall a. ExceptT String HandlerM (Either String a)
goUser pool =
  ExceptT (getRouteParam "id" <#> note "User ID is required")
    >>= ((\sUserId -> (fromString <#> note ("User ID must be an integer: " <> sUserId)) sUserId) >>> except)
    >>= (\id -> liftAff (P.findUser pool id) <#> note "User not found with id ") -- <-like to use sUserId here!
    >>= (encode >>> Right >>> except) 
    
getUser :: Pool -> Handler
getUser pool = runExceptT (goUser pool) >>> respondEither
#5

I believe using do notation in your ExceptT block will make that possible.
Here’s the gist of what should work, although you’ll likely need to mess around a bit with it to get it to compile:

goUser :: Pool -> forall a. ExceptT String HandlerM (Either String a)
goUser pool =
  ExceptT do
    sUserId <- getRouteParam "id" <#> note "User ID is required"
    id <- (fromString <#> note ("User ID must be an integer: " <> sUserId)) sUserId
    user <- liftAff (P.findUser pool id) <#> note "User not found with id " <> show sUserId
    pure $ Right $ encode user
#6

ok thanks. For the sake of completeness, I have settled on

format1 :: forall a. Show a => String -> a -> String
format1 str x = replaceAll (Pattern ("{1}")) (Replacement (show x)) str

type ExceptHandler
  = ExceptT String HandlerM

getId :: ExceptHandler String
getId = do
  id <- lift $ getRouteParam "id"
  except $ note "User id not provided" id

idToInt :: String -> ExceptHandler Int
idToInt sUserId =
  (fromString sUserId) # note (format1 "User id {1} could not be converted to integer" sUserId)
    >>> except

findUser :: Pool -> Int -> ExceptHandler User
findUser p id =
  liftAff (P.findUser p id)
    >>= note (format1 "User id {1} not found in storage" id)
    >>> except

getUser :: Pool -> HandlerM Unit
getUser pool = runExceptT (getId >>= idToInt >>= findUser pool) >>= respondUser