@@ -52,6 +52,7 @@ module Data.Yaml
5252 -- ** Better error information
5353 , decodeEither
5454 , decodeEither'
55+ , decodeFileEither
5556 -- ** More control over decoding
5657 , decodeHelper
5758 ) where
@@ -68,7 +69,7 @@ import Data.ByteString (ByteString)
6869import qualified Data.ByteString.Char8 as S8
6970import qualified Data.Map as Map
7071import System.IO.Unsafe (unsafePerformIO)
71−import Control.Exception (try, throwIO, fromException, Exception)
72+import Control.Exception (try, throwIO, fromException, Exception, SomeException, AsyncException)
7273import Control.Monad.Trans.State
7374import qualified Data.Conduit as C
7475import qualified Data.Conduit.List as CL
@@ -142,6 +143,7 @@ data ParseException = NonScalarKey
142143 }
143144 | InvalidYaml (Maybe YamlException)
144145 | AesonException String
146+ | OtherParseException SomeException
145147 deriving (Show, Typeable)
146148instance Exception ParseException
147149
@@ -278,6 +280,32 @@ decodeFile :: FromJSON a
278280 -> IO (Maybe a)
279281decodeFile fp = decodeHelper (Y.decodeFile fp) >>= either throwIO (return . either (const Nothing) id)
280282
283+-- | A version of 'decodeFile' which should not throw runtime exceptions.
284+--
285+-- Since 0.8.4
286+decodeFileEither
287+ :: FromJSON a
288+ => FilePath
289+ -> IO (Either ParseException a)
290+decodeFileEither fp = do
291+ x <- try $ C.runResourceT $ flip evalStateT Map.empty $ Y.decodeFile fp C.$$ parse
292+ case x of
293+ Left e
294+ | Just pe <- fromException e -> return $ Left pe
295+ | Just ye <- fromException e -> return $ Left $ InvalidYaml $ Just (ye :: YamlException)
296+ | shouldBeCaught e -> return $ Left $ OtherParseException e
297+ | otherwise -> throwIO e
298+ Right y ->
299+ return $ case parseEither parseJSON y of
300+ Left s -> Left $ AesonException s
301+ Right v -> Right v
302+ where
303+ -- FIXME this function needs more thought
304+ shouldBeCaught e
305+ | Just (_ :: AsyncException) <- fromException e = False
306+ -- Would be nice... | Just (_ :: Timeout) <- fromException e = False
307+ | otherwise = True
308+
281309decodeEither :: FromJSON a => ByteString -> Either String a
282310decodeEither bs = unsafePerformIO
283311 $ fmap (either (Left . show) id)