From ed3aace2060792366edeac6cbe3ea415ac6db205 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Mon, 16 Dec 2013 18:52:04 +0400 Subject: Allow to catch fail :: Get a from pure code --- src/Data/BEncode.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'src/Data/BEncode.hs') diff --git a/src/Data/BEncode.hs b/src/Data/BEncode.hs index 8768dac..a866a6e 100644 --- a/src/Data/BEncode.hs +++ b/src/Data/BEncode.hs @@ -643,7 +643,21 @@ endDict = Nil -- "length" < "md5sum" < "path" < "tags". -- newtype Get a = Get { runGet :: StateT BDict Result a } - deriving (Functor, Applicative, Alternative, Monad) + deriving (Functor, Applicative, Alternative) + +-- | 'fail' is catchable from pure code. +instance Monad Get where + return a = Get (return a) + {-# INLINE return #-} + + Get m >>= f = Get (m >>= runGet . f) + {-# INLINE (>>=) #-} + + Get m >> Get n = Get (m >> n) + {-# INLINE (>>) #-} + + fail msg = Get (lift (Left msg)) + {-# INLINE fail #-} -- | Get lexicographical successor of the current key\/value pair. next :: Get BValue -- cgit v1.2.3