git.iko.soy/typeable/yaml
on master help sign in
Migrated to control-monad-failure
810394bMichael Snoyman
Text/Libyaml.hs−1
compare with master
unifiedsplit
@@ -21,7 +21,6 @@ import Foreign.ForeignPtr
21import Foreign.Marshal.Alloc
21import Foreign.Marshal.Alloc
22
22
23import Data.Attempt
23import Data.Attempt
24−import Control.Monad.Attempt.Class
25
24
26data ParserStruct
25data ParserStruct
27type Parser = Ptr ParserStruct
26type Parser = Ptr ParserStruct
Text/Yaml.hs+10−10
@@ -33,10 +33,8 @@ import Data.Object.Raw
33import System.IO.Unsafe
33import System.IO.Unsafe
34import Control.Arrow (first, (***))
34import Control.Arrow (first, (***))
35import Control.Monad (replicateM, liftM)
35import Control.Monad (replicateM, liftM)
36−import qualified Data.Attempt.Helper as A
37import Control.Monad.Trans
36import Control.Monad.Trans
38import Control.Monad.Attempt
37import Control.Monad.Attempt
39−import Control.Monad.Attempt.Class
40
38
41import Test.Framework (testGroup, Test)
39import Test.Framework (testGroup, Test)
42import Test.Framework.Providers.HUnit
40import Test.Framework.Providers.HUnit
@@ -44,10 +42,12 @@ import Test.Framework.Providers.QuickCheck (testProperty)
44import Test.HUnit hiding (Test, path)
42import Test.HUnit hiding (Test, path)
45import Test.QuickCheck
43import Test.QuickCheck
46
44
45+import Control.Exception
46+
47encode :: (StrictByteString bs, ToObject o Raw Raw) => o -> bs
47encode :: (StrictByteString bs, ToObject o Raw Raw) => o -> bs
48encode = unsafePerformIO . encode'
48encode = unsafePerformIO . encode'
49
49
50−decode :: (StrictByteString bs, FromObject o Raw Raw, MonadAttempt m)
50+decode :: (StrictByteString bs, FromObject o Raw Raw, MonadFailure SomeException m)
51 => bs
51 => bs
52 -> m o
52 -> m o
53decode bs = unsafePerformIO $ do
53decode bs = unsafePerformIO $ do
@@ -59,7 +59,7 @@ decode bs = unsafePerformIO $ do
59encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
59encodeFile :: ToObject o Raw Raw => FilePath -> o -> IO ()
60encodeFile path o = encode' o >>= B.writeFile path
60encodeFile path o = encode' o >>= B.writeFile path
61
61
62−decodeFile :: (FromObject o Raw Raw, MonadAttempt m, MonadIO m)
62+decodeFile :: (FromObject o Raw Raw, MonadFailure SomeException m, MonadIO m)
63 => FilePath
63 => FilePath
64 -> m o
64 -> m o
65decodeFile path = liftIO (B.readFile path) >>= decode'
65decodeFile path = liftIO (B.readFile path) >>= decode'
@@ -68,19 +68,19 @@ encode' :: (StrictByteString bs, ToObject o Raw Raw) => o -> IO bs
68encode' o =
68encode' o =
69 let events = objectToEvents $ toObject o
69 let events = objectToEvents $ toObject o
70 result = withEmitter $ flip emitEvents events
70 result = withEmitter $ flip emitEvents events
71− in fromStrictByteString `fmap` A.join result
71+ in fromStrictByteString `fmap` joinAttempt result
72
72
73decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
73decode' :: (StrictByteString bs, FromObject o Raw Raw, MonadIO m,
74− MonadAttempt m)
74+ MonadFailure SomeException m)
75 => bs
75 => bs
76 -> m o
76 -> m o
77decode' bs = do
77decode' bs = do
78 events <- liftIO $ withParser (toStrictByteString bs) parserParse
78 events <- liftIO $ withParser (toStrictByteString bs) parserParse
79− attempt failure (myFA . fromObject . eventsToRawObject) events
79+ attempt failure' (myFA . fromObject . eventsToRawObject) events
80 where
80 where
81− myFA :: MonadAttempt m => Attempt v -> m v
81+ myFA = attempt failure' return
82− myFA (Success v) = return v
82+ failure' :: (MonadFailure SomeException m, Exception e) => e -> m a
83− myFA (Failure e) = failure e
83+ failure' = failure . SomeException
84
84
85objectToEvents :: RawObject -> [Event]
85objectToEvents :: RawObject -> [Event]
86objectToEvents y = concat
86objectToEvents y = concat
yaml.cabal+3−1
@@ -28,7 +28,9 @@ library
28 time,
28 time,
29 QuickCheck >= 1 && < 2,
29 QuickCheck >= 1 && < 2,
30 attempt,
30 attempt,
31+ safe-failure,
31− transformers >= 0.1.4.0
32+ transformers >= 0.1.4.0,
33+ control-monad-failure
32 exposed-modules: Text.Yaml
34 exposed-modules: Text.Yaml
33 other-modules: Text.Libyaml
35 other-modules: Text.Libyaml
34 ghc-options: -Wall
36 ghc-options: -Wall