There is a method:
import Control.Applicative ((<$>))
import Network.HTTP.Types
getJSON :: String -> IO (Either String Value)
getJSON url = eitherDecode <$> simpleHttp url
And instead of this:
method1 :: String -> IO Object
method1 url = do
maybeJson <- getJSON url
case maybeJson of
jsonValue ->
case jsonValue of
Object jsonObject -> return jsonObject
_ -> error "error123"
Left errorMsg -> error $ "error456"
I can do this:
method1 :: String -> IO Object
method1 url = do
Right jsonValue <- getJSON url
case jsonValue of
Object jsonObject -> return jsonObject
_ -> error "error123"
Is there any way to simplify it even more without using any libraries like lens?
If you don't care about the particular error messages, you could merge the patterns further:
method1 url = do
Right (Object jsonObject) <- getJSON url
return jsonObject
Related
I have an application that gets JSON response from an API and I'm trying to get a specific key from that response. The working code looks as below:
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Data.Aeson
import Network.HTTP.Req
tinyUIDRequest :: String -> Req (JsonResponse Object)
tinyUIDRequest url = let payload = object [ "url" .= url ]
in req
POST
(https "tinyuid.com" /: "api" /: "v1" /: "shorten") (
ReqBodyJson payload)
jsonResponse
mempty
main :: IO ()
main = do
response <- runReq defaultHttpConfig (tinyUIDRequest "http://google.com")
let body = responseBody response
print body
And the function to process the response should look similar to:
tinyUIDResponseHandler :: HttpResponseBody (JsonResponse Object) -> String
tinyUIDResponseHandler r = case lookup "result_url" r of
Just url -> url
Nothing -> ""
unfortunately I'm not able to figure out how to transform HttpResponseBody (JsonResponse Object) to something like hashmap/list and find a proper key. I was checking the documentation and req source code but maybe, as a beginner in Haskell, I don't know exactly what to look for to understand the internals of the response type.
HttpResponseBody is a red herring. It's an associated type, and HttpResponseBody (JsonResponse a) is the same as just a, so HttpResponseBody (JsonResponse Object) is really just Object. As such, once you have body, req's job is done, and it's now just aeson that you need to be concerned with.
Since body is an Object and not a list of tuples, you can't use Prelude's lookup on it. If your Aeson version is older than 2, then Object is just HashMap Text Value, so do this instead:
import Data.Text
import qualified Data.HashMap.Strict as HM
tinyUIDResponseHandler :: Object -> Text
tinyUIDResponseHandler r = case HM.lookup "result_url" r of
Just (String url) -> url
_ -> ""
If your Aeson version is 2 or newer, then Object is KeyMap Value, so do this instead:
import Data.Text
import qualified Data.Aeson.KeyMap as AKM
tinyUIDResponseHandler :: Object -> Text
tinyUIDResponseHandler r = case AKM.lookup "result_url" r of
Just (String url) -> url
_ -> ""
In either case, tinyUIDResponseHandler body will then be the value you want, so for example, you could do print (tinyUIDResponseHandler body).
I'm using the following scenario as an example to learn how to handle errors in a simple way. The scenario is basically read a file path from an environment variable, then read and print the file with the file path.
The following code works, but I don't like the printFile because it has nested case of, a bit hard to read. I wonder if there is a clean way to get rid of it and keep the printFile function flat without using lookupEnv?
How would you simplify this error handling flow?
module Main where
import Control.Exception (IOException, handle, throw)
import System.Environment (getEnv)
import System.IO.Error (isDoesNotExistError)
data MissingError
= MissingEnv String
| MissingFile String
deriving (Show)
main :: IO ()
main = do
eitherFile <- printFile
either print print eitherFile
getEnv' :: String -> MissingError -> IO (Either MissingError String)
getEnv' env err = handle (missingEnv err) $ Right <$> (getEnv env)
readFile' :: FilePath -> MissingError -> IO (Either MissingError String)
readFile' path err = handle (missingFile err) $ Right <$> (readFile path)
missingEnv :: MissingError -> IOException -> IO (Either MissingError String)
missingEnv err = const $ return $ Left err
missingFile :: MissingError -> IOException -> IO (Either MissingError String)
missingFile err e
| isDoesNotExistError e = return $ Left err
| otherwise = throw e
printFile :: IO (Either MissingError String)
printFile = do
eitherFilePath <- getEnv' "FOLDER" (MissingEnv "FOLDER")
case eitherFilePath of
Left err -> return $ Left err
Right path -> readFile' path (MissingFile path)
You can use the ExceptT monad transformer for this. I haven't tried to run the following proposed changes, but it compiles, so I hope it works.
First, import the module that contains ExceptT:
import Control.Monad.Trans.Except
Next, change the printFile function:
printFile :: IO (Either MissingError String)
printFile = runExceptT $ do
path <- ExceptT $ getEnv' "FOLDER" (MissingEnv "FOLDER")
ExceptT $ readFile' path (MissingFile path)
You have functions that return IO (Either MissingError String), so wrapping them in ExceptT gives you do notation that enables you to access the String embedded in what's effectively ExcepT MissingError IO String.
Then unwrap the ExceptT return value with runExceptT.
The suggestion to use ExceptT is of course a good one but IMHO the proposed answer is still somewhat verbose and you can go a bit farther by simply "staying" in the ExceptT monad throughout your code. Also I would not recommend handling IO exceptions all over the place. Even with a small code base you would lose oversight of your code quickly. tryIOError is useful in this regard. And finally rethinking the definition of your errors would also yield easier to understand and a more solid solution. The end result would look something like this:
module Main where
import Data.Bifunctor (first)
import Control.Monad.Except (ExceptT(..), runExceptT)
import System.Environment (getEnv)
import System.IO.Error (tryIOError, isDoesNotExistError)
data MyError = MissingError String
| SomeIOError IOError
deriving (Show)
main :: IO ()
main = do
result <- runExceptT printFile
print result
getEnv' :: String -> ExceptT MyError IO String
getEnv' env = mapIOError ("getting env var " ++ env) $ getEnv env
readFile' :: FilePath -> ExceptT MyError IO String
readFile' path = mapIOError ("reading file " ++ path) $ readFile path
printFile :: ExceptT MyError IO String
printFile = do
path <- getEnv' "FOLDER"
readFile' path
mapIOError :: String -> IO a -> ExceptT MyError IO a
mapIOError msg = ExceptT . fmap (first mapError) . tryIOError
where mapError err | isDoesNotExistError err = MissingError msg
mapError err = SomeIOError err
I am making some http calls using wreq and would like to catch any exception and return an Either type. I tried something like this but could not figure out how to manipulate the calls so it will type check.
-- exhaustive pattern match omitted here
safeGetUrl :: URL -> Maybe Login -> Maybe Password -> IO (Either String (Response LBS.ByteString))
safeGetUrl url (Just login) (Just pass) = do
let def = defaults
opts = def & auth ?~ basicAuth (BS.pack login) (BS.pack pass)
r <- getWith opts url `E.catch` handler
return $ Right r
where
handler :: HttpException -> Either String (Response LBS.ByteString)
handler (StatusCodeException s _ _) = do
return $ Left $ LBS.unpack (s ^. statusMessage)
I am pasting the type error below but I know the above code will not compile. The issue is r <- getWith opts url E.catch handler. The first part returns IO (Res... but the exception handler returns Either... I tried adding lifting the getWith.. into Either but that did not type check either.
Couldn't match type ‘Either String (Response LBS.ByteString)’
with ‘IO (Response LBS.ByteString)’
Expected type: HttpException -> IO (Response LBS.ByteString)
Actual type: HttpException
-> Either String (Response LBS.ByteString)
In the second argument of ‘catch’, namely ‘handler’
In a stmt of a 'do' block: r <- getWith opts url `catch` handler
Is there a way to catch this exception and return an IO Either type?
Since #jozefg answer, the API has changed a little bit and the answer doesn't compile anymore.
Here is an updated version that compiles:
import qualified Control.Exception as E
import Control.Lens
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as LBS
import Network.HTTP.Client
import Network.Wreq as NW
type URL = String
type Login = String
type Password = String
safeGetUrl ::
URL
-> Maybe Login
-> Maybe Password
-> IO (Either String (Response LBS.ByteString))
safeGetUrl url (Just login) (Just pass) = do
let def = defaults
opts = def & auth ?~ basicAuth (BSC.pack login) (BSC.pack pass)
(Right <$> getWith opts url) `E.catch` handler
where
handler :: HttpException -> IO (Either String (Response LBS.ByteString))
handler (HttpExceptionRequest _ (StatusCodeException r _)) =
return $ Left $ BSC.unpack (r ^. NW.responseStatus . statusMessage)
Your issue is that one side of the handle returns an unwrapped response (no Either) and the other side returns an Either-wrapped exception. You then attempt to wrap the response in an Either, which you do need to do, but it's just at the wrong place. You can fix this merely by switching where you do the wrapping
safeGetUrl :: URL -> Maybe Login -> Maybe Password -> IO (Either String (Response LBS.ByteString))
safeGetUrl url (Just login) (Just pass) = do
let def = defaults
opts = def & auth ?~ basicAuth (BS.pack login) (BS.pack pass)
(Right <$> getWith opts url) `E.catch` handler
where
handler :: HttpException -> IO (Either String (Response LBS.ByteString))
handler (StatusCodeException s _ _) = do
return $ Left $ LBS.unpack (s ^. statusMessage)
However there are some other problems with your functions, remember that unpack gives back Word8s not Char. You may want to import Data.ByteString.Char as the version of unpack defined in there should work better than LBS.unpack. Without your imports though I cannot confirm this definitively. The final (working) code for me is
import Control.Lens
import Network.Wreq
import Network.HTTP.Client
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as LBS
type URL = String
type Login = String
type Password = String
safeGetUrl :: URL
-> Maybe Login
-> Maybe Password
-> IO (Either String (Response LBS.ByteString))
safeGetUrl url (Just login) (Just pass) = do
let def = defaults
opts = def & auth ?~ basicAuth (BSC.pack login) (BSC.pack pass)
(Right <$> getWith opts url) `E.catch` handler
where
handler :: HttpException -> IO (Either String (Response LBS.ByteString))
handler (StatusCodeException s _ _) = do
return $ Left $ BSC.unpack (s ^. statusMessage)
Something that happens to me a lot while web programming: I want to run an operation that has a chance of failure. On a failure, I want to send the client a 500. Normally though, I just want to continue executing a series of steps.
doSomeWebStuff :: SomeWebMonad ()
doSomeWebStuff = do
res <- databaseCall
case res of
Left err -> status 500
Right val -> do
res2 <- anotherDatabaseCall (someprop val)
case res2 of
Left err -> status 500
Right val2 -> text $ show val2
since the errs are exceptions, I don't like that I need all that case stuff just to catch them. I want to do the same thing whenever anything is a left. Is there a way to express that on one line with something like guard, but control what it returns on an exit?
In another language I could do this:
function doSomeWebStuff() {
var res = databaseCall()
if (res == Error) return status 500
var res2 = anotherDatabaseCall(res.someprop)
if (res2 == Error) return status 500
return text(res2)
}
So, I'm ok writing some boilerplate, but I don't want the errors to mess with my nesting, when it's far more common to just want to continue forward with the found case.
What's the cleanest way to do this? I know in theory I can use a monad to exit early on a failure, but I've only seen examples with Maybe and it would return Nothing at the end, rather than letting me specify what it returns.
Here's how I would do it with ErrorT. Disclaimer: I have never actually used ErrorT before.
webStuffOr500 :: ErrorT String SomeWebMonad () -> SomeWebMonad ()
webStuffOr500 action = do
res <- runErrorT action
case res of
Left err -> do
logError err -- you probably want to know what went wrong
status 500
Right () -> return ()
doSomeWebStuff :: SomeWebMonad ()
doSomeWebStuff = webStuffOr500 doSomeWebStuff'
doSomeWebStuff' :: ErrorT String SomeWebMonad ()
doSomeWebStuff' = do
val <- ErrorT databaseCall
val2 <- ErrorT $ anotherDatabaseCall (someprop val)
lift $ text $ show val2
Here are the imports and type declarations I used to make sure it all typechecks correctly:
import Control.Monad.Identity
import Control.Monad.Error
import Control.Monad.Trans (lift)
import Control.Monad
type SomeWebMonad = Identity
data Foo = Foo
data Bar = Bar
data Baz = Baz deriving (Show)
someprop :: Foo -> Bar
someprop = undefined
databaseCall :: SomeWebMonad (Either String Foo)
databaseCall = undefined
anotherDatabaseCall :: Bar -> SomeWebMonad (Either String Baz)
anotherDatabaseCall = undefined
logError :: String -> SomeWebMonad ()
logError = undefined
text :: String -> SomeWebMonad ()
text = undefined
status :: Int -> SomeWebMonad ()
status = undefined
If I'm doing this all wrong then please, somebody shout out. It may be wise, if you take this approach, to modify the type signature of databaseCall and anotherDatabaseCall to also use ErrorT, that way a <- ErrorT b can be reduced to a <- b in doSomeWebStuff'.
Since I'm a complete noob at ErrorT, I can't really do any hand-holding besides "here's some code, go have some fun".
Not a direct answer to your question, but have you considered using Snap? In snap, we have short-circuiting behavior built-in with an idiomatic:
getResponse >>= finishWith
where
finishWith :: MonadSnap m => Response -> m a
So given a response object, it will terminate early (and match whatever type comes after that). Haskell laziness will ensure computations within Snap monad after finishWith won't be executed.
I sometimes make a little helper:
finishEarly code str = do
modifyResponse $ setResponseStatus code str
modifyResponse $ addHeader "Content-Type" "text/plain"
writeBS str
getResponse >>= finishWith
which I can then use anywhere in my handlers.
myHandler = do
x <- doSomething
when (x == blah) $ finishEarly 400 "That doesn't work!!"
doOtherStuff
parseSource :: String -> Either ParserError Mod.Module
parseSource src = do
(imports, rest) <- parseImports (Lex.lexSource src)
bindings <- mapM parseBinding rest
buildModule imports bindings
I need to make the above return an IO (Either ParserError Mod.Module) as the buildModule statement at the end will need to perform some IO functions (reading files). The problem i have is that when i make it an IO function, i can no longer do the bind(wrong term?) <- operations.
What is the simplest way to make this work?
Take a look at defining your problem in terms of ErrorT ParseError IO.
I couldn't find a combinator to lift a pure Either computation into the ErrorT monad, so I wrote one called liftError. I fleshed out your example with dummy types and implementations. The main runs the parser twice, once with input that throws a ParserError, and once which succeeds with an IO side-effect. In order for ErrorT ParserError IO to be a Monad, ParserError must be an instance of Error (so that it is possible to implement fail).
import Control.Monad.Error
type ParserMonad = ErrorT ParserError IO
data ParserError = ParserError1 | ParserError2 | ParserError3
deriving(Show)
data Module = Module
deriving(Show)
data Import = Import
deriving(Show)
data Binding = Binding
deriving(Show)
instance Error ParserError where
noMsg = undefined
-- lift a pure Either into the ErrorT monad
liftError :: Monad m => Either e a -> ErrorT e m a
liftError = ErrorT . return
parseSource :: String -> ParserMonad Module
parseSource src = do
(imports, rest) <- liftError $ parseImports (lexSource src)
bindings <- liftError $ mapM parseBinding rest
buildModule imports bindings
lexSource :: String -> [String]
lexSource = return
parseImports :: [String] -> Either ParserError ([Import], [String])
parseImports toks = do{ when (null toks) $ throwError ParserError1
; return ([Import], toks)
}
parseBinding :: String -> Either ParserError Binding
parseBinding b = do{ when (b == "hello") $ throwError ParserError2
; return Binding
}
buildModule :: [Import] -> [Binding] -> ParserMonad Module
buildModule i b = do{ liftIO $ print "hello"
; when (null b) $ throwError ParserError3
; return Module
}
main = mapM (runErrorT . parseSource) ["hello", "world"]