Using optparse-applicative, I'd like to have an optional argument, which should be a path to a file, or when not specified, stdin
. The obvious choice here is to make this argument type IO Handle
and when an argument is passed in use openFile
. Here's what I have currently:
module Main where
import Data.Semigroup ((<>))
import Options.Applicative
import System.IO
data Args = Args { input :: IO Handle }
parseArgs = Args <$> argument parseReadHandle (value defaultHandle)
where defaultHandle = return stdin :: IO Handle
parseReadHandle :: ReadM (IO Handle)
parseReadHandle = eitherReader $ \path -> Right $ openFile path ReadMode
getArgs :: IO Args
getArgs = execParser $ info (parseArgs <**> helper) fullDesc
main :: IO ()
main = run =<< getArgs
run :: Args -> IO ()
run (Args input) = putStrLn =<< hGetContents =<< input
The trouble with this is, we don't properly handle
exceptions from openFile
and instead rely on the default behavior for an unhandled exception (prints error and exits). This seems yucky.
I think the more proper way would be to return Left
with the error message from openFile
. The trouble is, eitherReader
expects a String -> Either String a
so we can't do something like:
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception
parseReadHandle :: ReadM (IO Handle)
parseReadHandle = eitherReader tryOpenFile
tryOpenFile :: IO (Either String (IO Handle)) -> FilePath
tryOpenFile path = do
handle (\(e :: IOException) -> return $ Left $ show e) $ do
return $ Right $ openFile path ReadMode
Of course, you can see from the type of tryOpenFile
that this won't typecheck. I'm unsure if what I'm asking for is possible, because it seems like the error message must be an IO String
, because to get the error the IO computation must be performed. So at the least it seems you would need eitherReader
to take a String -> IO (Either String a)
or a String -> Either (IO String) (IO Handle)
. From my basic understanding of them, it sounds like a monad transformer could be used here to wrap the ReadM (or the other way around?). But that's a bit deeper than my understanding goes, and I'm at a loss about how to precede.
Is there a way to accomplish handle
ing an IOException
in an optparse-applicative ReadM
?