diff --git a/midi.cabal b/midi.cabal
--- a/midi.cabal
+++ b/midi.cabal
@@ -1,5 +1,5 @@
 Name:             midi
-Version:          0.1.1
+Version:          0.1.2
 License:          GPL
 License-File:     LICENSE
 Author:           Henning Thielemann <haskell@henning-thielemann.de>
@@ -29,6 +29,7 @@
 
 Library
   Build-Depends: event-list >=0.0.6 && < 0.1, non-negative>=0.0.1 && <0.1
+  Build-Depends: explicit-exception >=0.0.1 && <0.1
   Build-Depends: bytestring >=0.9.0.1 && <0.10, binary >=0.4.2 && <0.5
   Build-Depends: mtl >=1 && <2, QuickCheck >=1 && <2
   If flag(splitBase)
@@ -66,7 +67,8 @@
     -- Parser class and general parser functions
     Sound.MIDI.Parser.Class
     Sound.MIDI.Parser.Restricted
-    Sound.MIDI.Parser.State
+    Sound.MIDI.Parser.Exception
+    Sound.MIDI.Parser.Warning
     Sound.MIDI.Parser.Primitive
     Sound.MIDI.Parser.Status
     -- concrete Parsers
diff --git a/src/Sound/MIDI/File/Event.hs b/src/Sound/MIDI/File/Event.hs
--- a/src/Sound/MIDI/File/Event.hs
+++ b/src/Sound/MIDI/File/Event.hs
@@ -84,7 +84,7 @@
 
 -- * serialization
 
-get :: Parser.C parser => StatusParser.T parser T
+get :: Parser.C parser => Parser.Fallible (StatusParser.T parser) T
 get =
    StatusParser.lift get1 >>= \tag ->
    if tag < 0xF0
@@ -101,7 +101,7 @@
 last event and the current event.  Parse a time and an event, ignoring
 System Exclusive messages.
 -}
-getTrackEvent :: Parser.C parser => StatusParser.T parser TrackEvent
+getTrackEvent :: Parser.C parser => Parser.Fallible (StatusParser.T parser) TrackEvent
 getTrackEvent  =  liftM2 (,) (StatusParser.lift getVar) get
 
 
diff --git a/src/Sound/MIDI/File/Event/Meta.hs b/src/Sound/MIDI/File/Event/Meta.hs
--- a/src/Sound/MIDI/File/Event/Meta.hs
+++ b/src/Sound/MIDI/File/Event/Meta.hs
@@ -156,11 +156,11 @@
 
 -- * serialization
 
-get :: Parser.C parser => parser T
+get :: Parser.C parser => Parser.Fallible parser T
 get =
    do code <- get1
       len  <- getVar
-      let parse = ParserRestricted.run len
+      let parse = ParserRestricted.runFallible len
       let returnText cons = liftM (cons . listCharFromByte) $ getBigN len
       case code of
          000 -> parse $ liftM SequenceNum get2
diff --git a/src/Sound/MIDI/File/Event/SystemExclusive.hs b/src/Sound/MIDI/File/Event/SystemExclusive.hs
--- a/src/Sound/MIDI/File/Event/SystemExclusive.hs
+++ b/src/Sound/MIDI/File/Event/SystemExclusive.hs
@@ -30,7 +30,7 @@
      deriving (Show, Eq, Ord)
 
 
-get :: Parser.C parser => Int -> parser T
+get :: Parser.C parser => Int -> Parser.Fallible parser T
 get tag =
    case tag of
       0xF0 -> liftM Regular $ getBigN =<< getVar
diff --git a/src/Sound/MIDI/File/Load.hs b/src/Sound/MIDI/File/Load.hs
--- a/src/Sound/MIDI/File/Load.hs
+++ b/src/Sound/MIDI/File/Load.hs
@@ -29,22 +29,22 @@
 -- import qualified Sound.MIDI.Bit as Bit
 import           Sound.MIDI.String (unlinesS)
 import           Sound.MIDI.Parser.Primitive
-import           Sound.MIDI.Parser.Class (PossiblyIncomplete, )
 import qualified Sound.MIDI.Parser.Class as Parser
-import qualified Sound.MIDI.Parser.Restricted as ParserRestricted
-import qualified Sound.MIDI.Parser.ByteString as ParserByteString
-import qualified Sound.MIDI.Parser.Stream as ParserStream
-import qualified Sound.MIDI.Parser.File   as ParserFile
-import qualified Sound.MIDI.Parser.State  as ParserState
+import qualified Sound.MIDI.Parser.Restricted as RestrictedParser
+import qualified Sound.MIDI.Parser.ByteString as ByteStringParser
+import qualified Sound.MIDI.Parser.Stream as StreamParser
+import qualified Sound.MIDI.Parser.File   as FileParser
 import qualified Sound.MIDI.Parser.Status as StatusParser
 import qualified Sound.MIDI.Parser.Report as Report
 import qualified Control.Monad.State as State
-import Control.Monad (liftM, liftM2, when, )
+import Control.Monad.Trans (lift, )
+import Control.Monad (liftM, liftM2, )
 
 import qualified Data.ByteString.Lazy as B
 
+import qualified Control.Monad.Exception.Asynchronous as Async
+-- import qualified Control.Monad.Exception.Synchronous  as Sync
 -- import System.IO (hPutStrLn, stderr, )
-import Sound.MIDI.Utility (mapSnd, )
 import Data.List (genericReplicate, genericLength, )
 import Data.Maybe (catMaybes, )
 
@@ -54,22 +54,22 @@
 Warnings are written to standard error output
 and an error is signaled by a user exception.
 This function will not be appropriate in GUI applications.
-For these, use 'fromByteList' instead.
+For these, use 'maybeFromByteString' instead.
 -}
 fromFile :: FilePath -> IO MIDIFile.T
 fromFile =
-   ParserFile.runIncompleteFile parse
+   FileParser.runIncompleteFile parse
 
 
 {-
 fromFile :: FilePath -> IO MIDIFile.T
 fromFile filename =
    do report <- fmap maybeFromByteList $ readBinaryFile filename
-      mapM_ (hPutStrLn stderr . ("MIDI.File.Load warning: " ++)) (ParserStream.warnings report)
+      mapM_ (hPutStrLn stderr . ("MIDI.File.Load warning: " ++)) (StreamParser.warnings report)
       either
          (ioError . userError . ("MIDI.File.Load error: " ++))
          return
-         (ParserStream.result report)
+         (StreamParser.result report)
 -}
 
 {- |
@@ -86,12 +86,12 @@
 maybeFromByteList ::
    ByteList -> Report.T MIDIFile.T
 maybeFromByteList =
-   ParserStream.runIncomplete parse . ParserStream.ByteList
+   StreamParser.runIncomplete parse . StreamParser.ByteList
 
 maybeFromByteString ::
    B.ByteString -> Report.T MIDIFile.T
 maybeFromByteString =
-   ParserByteString.runIncomplete parse
+   ByteStringParser.runIncomplete parse
 
 
 
@@ -102,32 +102,30 @@
 any non-header chunks that come before a header chunk.  The header tells us
 the number of tracks to come, which is passed to 'getTracks'.
 -}
-parse :: Parser.C parser => parser (PossiblyIncomplete MIDIFile.T)
+parse :: Parser.C parser => Parser.Partial (Parser.Fallible parser) MIDIFile.T
 parse =
    getChunk >>= \ (typ, hdLen) ->
       case typ of
         "MThd" ->
            do (format, nTracks, division) <-
-                 ParserRestricted.run hdLen getHeader
-              ~(me, tracks) <-
-                 Parser.zeroOrMoreInc
-                    (do (me0,track) <- getTrackChunk
-{-
-                        let trackNoEOT = track
--}
-                        trackNoEOT <-
-                           maybe (return Nothing) (liftM Just . removeEndOfTrack) track
-                        return (me0, trackNoEOT))
-              let n = genericLength tracks
-              Parser.force $ when (n /= nTracks) $
-                 Parser.warn ("header says " ++ show nTracks ++
-                    " tracks, but " ++ show n ++ " tracks were found")
-              return (me, MIDIFile.Cons format division $ catMaybes tracks)
-        _ -> Parser.warn ("found Alien chunk <" ++ typ ++ ">") >>
+                 RestrictedParser.runFallible hdLen getHeader
+              excTracks <-
+                 lift $ Parser.zeroOrMoreInc
+                    (getTrackChunk >>= Async.mapM (lift . liftMaybe removeEndOfTrack))
+              flip Async.mapM excTracks $ \tracks ->
+                 do let n = genericLength tracks
+                    lift $ Parser.warnIf (n /= nTracks)
+                       ("header says " ++ show nTracks ++
+                        " tracks, but " ++ show n ++ " tracks were found")
+                    return (MIDIFile.Cons format division $ catMaybes tracks)
+        _ -> lift (Parser.warn ("found Alien chunk <" ++ typ ++ ">")) >>
              Parser.skip hdLen >>
              parse
 
 
+liftMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
+liftMaybe f = maybe (return Nothing) (liftM Just . f)
+
 {- |
 There are two ways to mark the end of the track:
 The end of the event list and the meta event 'EndOfTrack'.
@@ -143,12 +141,12 @@
       (\(initEvents, lastEvent) ->
           let (eots, track) =
                  EventList.partition isEndOfTrack initEvents
-          in  do Parser.force $ when
+          in  do Parser.warnIf
                     (not $ EventList.null eots)
-                    (Parser.warn "EndOfTrack inside a track")
-                 Parser.force $ when
+                    "EndOfTrack inside a track"
+                 Parser.warnIf
                     (not $ isEndOfTrack $ snd lastEvent)
-                    (Parser.warn "Track does not end with EndOfTrack")
+                    "Track does not end with EndOfTrack"
                  return track)
       (EventList.viewR xs)
 
@@ -180,23 +178,23 @@
 four bytes for the size of the coming data,
 and the data itself.
 -}
-getChunk :: Parser.C parser => parser (String, NonNeg.Integer)
+getChunk :: Parser.C parser => Parser.Fallible parser (String, NonNeg.Integer)
 getChunk =
    liftM2 (,)
       (getString 4)  -- chunk type: header or track
       (getNByteCardinal 4)
                      -- chunk body
 
-getTrackChunk :: Parser.C parser => parser (PossiblyIncomplete (Maybe Track))
+getTrackChunk :: Parser.C parser => Parser.Partial (Parser.Fallible parser) (Maybe Track)
 getTrackChunk =
    do (typ, len) <- getChunk
       if typ=="MTrk"
-        then liftM (mapSnd Just) $
-             ParserRestricted.run len $
+        then liftM (fmap Just) $ lift $
+             RestrictedParser.run len $
              StatusParser.run getTrack
-        else Parser.warn ("found Alien chunk <" ++ typ ++ "> in track section") >>
+        else lift (Parser.warn ("found Alien chunk <" ++ typ ++ "> in track section")) >>
              Parser.skip len >>
-             return (Nothing, Nothing)
+             return (Async.pure Nothing)
 
 
 
@@ -205,7 +203,7 @@
 the number of track chunks to come, and the smallest time division
 to be used in reading the rest of the file.
 -}
-getHeader :: Parser.C parser => parser (MIDIFile.Type, NonNeg.Int, Division)
+getHeader :: Parser.C parser => Parser.Fallible parser (MIDIFile.Type, NonNeg.Int, Division)
 getHeader =
    do
       format   <- makeEnum =<< get2
@@ -217,7 +215,7 @@
 The division is implemented thus: the most significant bit is 0 if it's
 in ticks per quarter note; 1 if it's an SMPTE value.
 -}
-getDivision :: Parser.C parser => parser Division
+getDivision :: Parser.C parser => Parser.Fallible parser Division
 getDivision =
    do
       x <- get1
@@ -231,11 +229,11 @@
 A track is a series of events.  Parse a track, stopping when the size
 is zero.
 -}
-getTrack :: Parser.C parser => StatusParser.T parser (PossiblyIncomplete MIDIFile.Track)
+getTrack :: Parser.C parser => Parser.Partial (StatusParser.T parser) MIDIFile.Track
 getTrack =
    liftM
-      (mapSnd EventList.fromPairList)
-      (ParserState.zeroOrMore Event.getTrackEvent)
+      (fmap EventList.fromPairList)
+      (Parser.zeroOrMore Event.getTrackEvent)
 
 
 
@@ -251,7 +249,7 @@
 
 showChunks :: ByteList -> String
 showChunks mf =
-  showMR getChunks (\(me,cs) ->
+  showMR (lift getChunks) (\(Async.Exceptional me cs) ->
      unlinesS (map pp cs) .
      maybe id (\e -> showString ("incomplete chunk list: " ++ e ++ "\n")) me) mf ""
  where
@@ -261,8 +259,8 @@
     showMR getHeader shows contents
   pp ("MTrk",contents) =
     showString "Track:\n" .
-    showMR (StatusParser.run getTrack)
-        (\(me,track) str ->
+    showMR (lift $ StatusParser.run getTrack)
+        (\(Async.Exceptional me track) str ->
             EventList.foldr
                MIDIFile.showTime
                (\e -> MIDIFile.showEvent e . showString "\n")
@@ -276,9 +274,9 @@
     showString "\n"
 
 
-showMR :: ParserStream.T ParserStream.ByteList a -> (a->ShowS) -> ByteList -> ShowS
+showMR :: Parser.Fallible (StreamParser.T StreamParser.ByteList) a -> (a->ShowS) -> ByteList -> ShowS
 showMR m pp contents =
-  let report = ParserStream.run m (ParserStream.ByteList contents)
+  let report = StreamParser.run m (StreamParser.ByteList contents)
   in  unlinesS (map showString $ Report.warnings report) .
       either showString pp (Report.result report)
 
@@ -297,7 +295,7 @@
 
 -}
 getChunks ::
-   Parser.C parser => parser (PossiblyIncomplete [(String, ByteList)])
+   Parser.C parser => Parser.Partial parser [(String, ByteList)]
 getChunks =
    Parser.zeroOrMore $
       do (typ, len) <- getChunk
diff --git a/src/Sound/MIDI/Manufacturer.hs b/src/Sound/MIDI/Manufacturer.hs
--- a/src/Sound/MIDI/Manufacturer.hs
+++ b/src/Sound/MIDI/Manufacturer.hs
@@ -349,7 +349,7 @@
 
 -- * serialization
 
-get :: Parser.C parser => parser T
+get :: Parser.C parser => Parser.Fallible parser T
 get =
    do subId <- getByte
       if subId == 0
diff --git a/src/Sound/MIDI/Message.hs b/src/Sound/MIDI/Message.hs
--- a/src/Sound/MIDI/Message.hs
+++ b/src/Sound/MIDI/Message.hs
@@ -14,8 +14,7 @@
 import qualified Sound.MIDI.Message.System  as System
 
 import qualified Sound.MIDI.Parser.Status as StatusParser
-import           Sound.MIDI.Parser.Class (PossiblyIncomplete, )
-import qualified Sound.MIDI.Parser.Class as Parser
+import qualified Sound.MIDI.Parser.Class  as Parser
 import           Sound.MIDI.Parser.Primitive (get1)
 import qualified Sound.MIDI.Parser.ByteString as ParserByteString
 
@@ -24,20 +23,20 @@
 
 import qualified Sound.MIDI.Parser.Report as Report
 
+import qualified Control.Monad.Exception.Asynchronous as Async
+
 import Control.Monad.Trans (lift, )
 import Control.Monad (liftM, )
 
 import qualified Data.ByteString.Lazy as B
 
-import Sound.MIDI.Utility (mapSnd, )
 
-
 data T =
      Channel Channel.T
    | System  System.T
 
 
-get :: Parser.C parser => parser T
+get :: Parser.C parser => Parser.Fallible parser T
 get =
    get1 >>= \code ->
    if code >= 0xF0
@@ -45,7 +44,7 @@
      else liftM Channel $ (uncurry Channel.get (Channel.decodeStatus code) =<< get1)
 --     else liftM Channel $ StatusParser.run (Channel.getWithStatus code)
 
-getWithStatus :: Parser.C parser => StatusParser.T parser T
+getWithStatus :: Parser.C parser => Parser.Fallible (StatusParser.T parser) T
 getWithStatus =
    StatusParser.lift get1 >>= \code ->
    if code >= 0xF0
@@ -54,12 +53,12 @@
      else liftM Channel $ Channel.getWithStatus code
 
 getIncompleteWithStatus ::
-   Parser.C parser => StatusParser.T parser (PossiblyIncomplete T)
+   Parser.C parser => Parser.Partial (Parser.Fallible (StatusParser.T parser)) T
 getIncompleteWithStatus =
    StatusParser.lift get1 >>= \code ->
    if code >= 0xF0
-     then liftM (mapSnd System) $ StatusParser.lift $ System.getIncomplete code
-     else liftM ((,) Nothing . Channel) $ Channel.getWithStatus code
+     then liftM (fmap System) $ StatusParser.lift $ System.getIncomplete code
+     else liftM (Async.pure . Channel) $ Channel.getWithStatus code
 
 maybeFromByteString :: B.ByteString -> Report.T T
 maybeFromByteString =
diff --git a/src/Sound/MIDI/Message/Channel.hs b/src/Sound/MIDI/Message/Channel.hs
--- a/src/Sound/MIDI/Message/Channel.hs
+++ b/src/Sound/MIDI/Message/Channel.hs
@@ -20,9 +20,9 @@
 import           Sound.MIDI.Parser.Primitive
 import qualified Sound.MIDI.Parser.Class as Parser
 import Sound.MIDI.Parser.Status
-   (lift,
-    Channel, fromChannel,   toChannel, )
+   (Channel, fromChannel,   toChannel, )
 
+import Control.Monad.Trans (lift, )
 import Control.Monad (liftM, liftM2, when, )
 
 import qualified Sound.MIDI.Writer.Status as StatusWriter
@@ -74,17 +74,17 @@
 (it's been nice enough to keep track of it for us),
 and the tag that we've already gotten is the first byte of data.
 -}
-getWithStatus :: Parser.C parser => Int -> StatusParser.T parser T
+getWithStatus :: Parser.C parser => Int -> Parser.Fallible (StatusParser.T parser) T
 getWithStatus tag =
    do (status@(code, channel), firstData) <-
          if tag < 0x80
            then maybe
-                   (lift $ Parser.giveUp "messages wants to repeat status byte, but there was no status yet")
+                   (Parser.giveUp "messages wants to repeat status byte, but there was no status yet")
                    (\cc -> return (cc,tag))
                       =<< StatusParser.get
-           else liftM ((,) $ decodeStatus tag) $ lift get1
+           else liftM ((,) $ decodeStatus tag) $ StatusParser.lift get1
       StatusParser.set (Just status)
-      lift $ get code channel firstData
+      StatusParser.lift $ get code channel firstData
 
 -- | for internal use
 decodeStatus :: Int -> (Int, Channel)
@@ -97,7 +97,7 @@
 the code, channel and first data byte
 must be determined by the caller.
 -}
-get :: Parser.C parser => Int -> Channel -> Int -> parser T
+get :: Parser.C parser => Int -> Channel -> Int -> Parser.Fallible parser T
 get code channel firstData =
    liftM (Cons channel) $
    if code == 11 && firstData >= 0x78
diff --git a/src/Sound/MIDI/Message/Channel/Mode.hs b/src/Sound/MIDI/Message/Channel/Mode.hs
--- a/src/Sound/MIDI/Message/Channel/Mode.hs
+++ b/src/Sound/MIDI/Message/Channel/Mode.hs
@@ -12,12 +12,14 @@
 
 import Sound.MIDI.Parser.Report (UserMessage, )
 
+import qualified Control.Monad.Exception.Asynchronous as Async
 import Sound.MIDI.Utility (toMaybe, )
+import Control.Monad.Trans (lift, )
+import Control.Monad (liftM, )
 
 import Test.QuickCheck (Arbitrary(arbitrary), )
 import qualified Test.QuickCheck as QC
 
-import Control.Monad (liftM, )
 
 
 data T =
@@ -46,13 +48,15 @@
 
 -- * serialization
 
-get :: Parser.C parser => Int -> parser T
+get :: Parser.C parser => Int -> Parser.Fallible parser T
 get mode =
    do x <- get1
-      let (w, msg) = fromControllerValue (mode,x)
-      maybe (return ()) Parser.warn w
-      return msg
+      lift $ Parser.warnIncomplete $ uncurry Async.Exceptional $ fromControllerValue (mode,x)
 
+{- |
+This function is also used in alsa-midi,
+we could give it the result type @Parser.PossiblyIncomplete T@ otherwise.
+-}
 fromControllerValue :: Integral a => (a, a) -> (Maybe UserMessage, T)
 fromControllerValue (mode,x) =
    case mode of
diff --git a/src/Sound/MIDI/Message/Channel/Voice.hs b/src/Sound/MIDI/Message/Channel/Voice.hs
--- a/src/Sound/MIDI/Message/Channel/Voice.hs
+++ b/src/Sound/MIDI/Message/Channel/Voice.hs
@@ -409,7 +409,7 @@
 
 -- * serialization
 
-get :: Parser.C parser => Int -> Int -> parser T
+get :: Parser.C parser => Int -> Int -> Parser.Fallible parser T
 get code firstData =
    let pitch  = toPitch firstData
        getVel = liftM toVelocity get1
diff --git a/src/Sound/MIDI/Message/System.hs b/src/Sound/MIDI/Message/System.hs
--- a/src/Sound/MIDI/Message/System.hs
+++ b/src/Sound/MIDI/Message/System.hs
@@ -10,14 +10,14 @@
 import qualified Sound.MIDI.Message.System.RealTime  as RealTime
 
 -- import           Sound.MIDI.Parser.Primitive
-import           Sound.MIDI.Parser.Class (PossiblyIncomplete, )
 import qualified Sound.MIDI.Parser.Class as Parser
 
 import qualified Sound.MIDI.Writer.Basic as Writer
 
+import qualified Control.Monad.Exception.Asynchronous as Async
+
 import Control.Monad (liftM, )
 
-import Sound.MIDI.Utility (mapSnd, )
 
 
 data T =
@@ -26,7 +26,7 @@
    | RealTime  RealTime.T
 
 
-get :: Parser.C parser => Int -> parser T
+get :: Parser.C parser => Int -> Parser.Fallible parser T
 get code =
    if code == 0xF0
      then liftM Exclusive Exclusive.get
@@ -38,16 +38,16 @@
              then liftM RealTime $ RealTime.get code
              else Parser.giveUp ("invalid System message code " ++ show code)
 
-getIncomplete :: Parser.C parser => Int -> parser (PossiblyIncomplete T)
+getIncomplete :: Parser.C parser => Int -> Parser.Partial (Parser.Fallible parser) T
 getIncomplete code =
    if code == 0xF0
-     then liftM (mapSnd Exclusive) Exclusive.getIncomplete
+     then liftM (fmap Exclusive) Exclusive.getIncomplete
      else
        if code >= 0xF1 && code <= 0xF6
-         then liftM ((,) Nothing . Common) $ Common.get code
+         then liftM (Async.pure . Common) $ Common.get code
          else
            if code >= 0xF8 && code <= 0xFF
-             then liftM ((,) Nothing . RealTime) $ RealTime.get code
+             then liftM (Async.pure . RealTime) $ RealTime.get code
              else Parser.giveUp ("invalid System message code " ++ show code)
 
 
diff --git a/src/Sound/MIDI/Message/System/Common.hs b/src/Sound/MIDI/Message/System/Common.hs
--- a/src/Sound/MIDI/Message/System/Common.hs
+++ b/src/Sound/MIDI/Message/System/Common.hs
@@ -8,7 +8,8 @@
 import           Sound.MIDI.Parser.Primitive
 import qualified Sound.MIDI.Parser.Class as Parser
 
-import Control.Monad (liftM, liftM2, when, )
+import Control.Monad.Trans (lift, )
+import Control.Monad (liftM, liftM2, )
 
 import qualified Sound.MIDI.Writer.Basic as Writer
 
@@ -38,15 +39,15 @@
 
 -- * serialization
 
-get :: Parser.C parser => Int -> parser T
+get :: Parser.C parser => Int -> Parser.Fallible parser T
 get code =
    case code of
       0xF1 ->
          do dat <- get1
             let (nib, value)  = Bit.splitAt 4 dat
             let (msb, nibble) = Bit.splitAt 3 nib
-            when (msb/=0)
-               (Parser.warn "TimeCodeQuarterFrame: most significant bit must 0")
+            lift $ Parser.warnIf (msb/=0)
+               "TimeCodeQuarterFrame: most significant bit must 0"
             return $ TimeCodeQuarterFrame (toEnum nibble) value
       0xF2 -> liftM2 (\lsb msb -> SongPositionPointer (lsb + Bit.shiftL 7 msb)) get1 get1
       0xF3 -> liftM SongSelect get1
diff --git a/src/Sound/MIDI/Message/System/Exclusive.hs b/src/Sound/MIDI/Message/System/Exclusive.hs
--- a/src/Sound/MIDI/Message/System/Exclusive.hs
+++ b/src/Sound/MIDI/Message/System/Exclusive.hs
@@ -9,12 +9,12 @@
 import Sound.MIDI.IO (ByteList)
 
 import           Sound.MIDI.Parser.Primitive
-import           Sound.MIDI.Parser.Class (PossiblyIncomplete, )
 import qualified Sound.MIDI.Parser.Class as Parser
 
 import qualified Sound.MIDI.Writer.Basic as Writer
 
--- import Control.Monad (liftM, liftM2, when, )
+import Control.Monad.Trans (MonadTrans, lift, )
+import qualified Control.Monad.Exception.Asynchronous as Async
 
 import Data.Maybe (fromMaybe, )
 
@@ -39,22 +39,26 @@
 
 -- * serialization
 
-get :: Parser.C parser => parser T
+get :: Parser.C parser => Parser.Fallible parser T
 get =
-   do (err, sysex) <- getIncomplete
+   do (Async.Exceptional err sysex) <- getIncomplete
       maybe (return sysex) Parser.giveUp err
 
-getIncomplete :: Parser.C parser => parser (PossiblyIncomplete T)
+getIncomplete :: Parser.C parser => Parser.Partial (Parser.Fallible parser) T
 getIncomplete =
    do manu <- Manufacturer.get
-      (err, body) <- Parser.until (0xf7 ==) getByte
-      return $ ((,) err) $
-        fromMaybe (Commercial manu body) $
-        lookup manu $
-           (Manufacturer.nonCommercial, NonCommercial body) :
-           (Manufacturer.nonRealTime,   NonRealTime $ NonRealTimeCons body) :
-           (Manufacturer.realTime,      RealTime    $ RealTimeCons body) :
-           []
+      incBody <- lift getBody
+      return $ flip fmap incBody $ \body ->
+         fromMaybe (Commercial manu body) $
+         lookup manu $
+            (Manufacturer.nonCommercial, NonCommercial body) :
+            (Manufacturer.nonRealTime,   NonRealTime $ NonRealTimeCons body) :
+            (Manufacturer.realTime,      RealTime    $ RealTimeCons body) :
+            []
+
+getBody :: Parser.C parser => Parser.Partial parser ByteList
+getBody = Parser.until (0xf7 ==) getByte
+
 
 {- |
 It is not checked whether SysEx messages contain only 7-bit values.
diff --git a/src/Sound/MIDI/Message/System/RealTime.hs b/src/Sound/MIDI/Message/System/RealTime.hs
--- a/src/Sound/MIDI/Message/System/RealTime.hs
+++ b/src/Sound/MIDI/Message/System/RealTime.hs
@@ -25,7 +25,7 @@
 
 -- * serialization
 
-get :: Parser.C parser => Int -> parser T
+get :: Parser.C parser => Int -> Parser.Fallible parser T
 get code =
    case code of
       0xF8 -> return TimingClock
diff --git a/src/Sound/MIDI/Parser/ByteString.hs b/src/Sound/MIDI/Parser/ByteString.hs
--- a/src/Sound/MIDI/Parser/ByteString.hs
+++ b/src/Sound/MIDI/Parser/ByteString.hs
@@ -10,12 +10,17 @@
 import qualified Data.Binary.Get as Binary
 import Data.Binary.Get (Get, runGet, )
 
-import Control.Monad (liftM, when, )
+import Control.Monad.Trans (lift, )
 
+import qualified Sound.MIDI.Parser.Report as Report
+
 import qualified Sound.MIDI.Parser.Class as Parser
 import Sound.MIDI.Parser.Class (UserMessage, PossiblyIncomplete, )
-import qualified Sound.MIDI.Parser.Report as Report
+import qualified Sound.MIDI.Parser.Exception as Exception
+import qualified Sound.MIDI.Parser.Warning   as Warning
 
+-- import qualified Control.Monad.Exception.Synchronous as Sync
+
 -- import Data.Word (Word8)
 
 import Data.Int (Int64)
@@ -25,7 +30,7 @@
 
 
 
-newtype T a = Cons {decons :: Get (Report.T a)}
+newtype T a = Cons {decons :: Warning.T Get a}
 
 
 {-
@@ -35,12 +40,13 @@
 -}
 
 
-run :: T a -> B.ByteString -> Report.T a
+run :: Parser.Fallible T a -> B.ByteString -> Report.T a
 run parser input =
-   flip runGet input $ decons $
+   flip runGet input $ Warning.run $ decons $ Exception.run $
       (do a <- parser
-          end <- Parser.isEnd
-          when (not end) (warn "unparsed data left over")
+          lift $
+             Parser.isEnd >>= \end ->
+                Parser.warnIf (not end) "unparsed data left over"
           return a)
 
 {- |
@@ -49,50 +55,44 @@
 and thus further parsing is not possible.
 -}
 runIncomplete ::
-   T (PossiblyIncomplete a) -> B.ByteString -> Report.T a
+   Parser.Partial (Parser.Fallible T) a -> B.ByteString -> Report.T a
 runIncomplete parser input =
    flip run input $
-      do (me,x) <- parser
-         maybe (return ()) warn me
-         return x
+      lift . Parser.warnIncomplete =<< parser
 
 
 fromGet :: Get a -> T a
 fromGet p =
-   Cons $ liftM (\a -> Report.Cons [] (Right a)) p
+   Cons $ lift p
 
 
 instance Monad T where
-   return x = fromGet $ return x
-   x >>= y  = Cons $
-      decons x >>= \ a ->
-         case Report.result a of
-            Left err -> return (Report.Cons (Report.warnings a) (Left err))
-            Right ar ->
-               decons (y ar) >>= \ b ->
-                  return (b{Report.warnings = Report.warnings a ++ Report.warnings b})
+   return = Cons . return
+   x >>= y = Cons $ decons . y =<< decons x
 
+
+instance Parser.EndCheck T where
+   isEnd = fromGet Binary.isEmpty
+
 instance Parser.C T where
-   isEnd   = fromGet Binary.isEmpty
 --   getByte = fromGet Binary.getWord8
--- a get getMabybeWord8 would be nice in order to avoid double-checking
+-- a get getMaybeWord8 would be nice in order to avoid double-checking
    getByte =
-      do end <- fromGet Binary.isEmpty
+      do end <- lift $ fromGet Binary.isEmpty
          if end
-           then giveUp "unexpected end of ByteString"
-           else fromGet Binary.getWord8
-   skip n  =
+           then Parser.giveUp "unexpected end of ByteString"
+           else lift $ fromGet Binary.getWord8
+
+   skip n =
       let toSize x =
             let y = if x > fromIntegral (maxBound `asTypeOf` y)
                       then error "skip: number too big"
                       else fromIntegral x
             in  y
-      in  fromGet $ skip $ toSize $ NonNeg.toNumber n
-   warn    = warn
-   giveUp  = giveUp
-   try     = try
-   force   = force
+      in  lift $ fromGet $ skip $ toSize $ NonNeg.toNumber n
 
+   warn = Cons . Warning.warn
+
 {- |
 In contrast to Binary.skip this one does not fail badly and it works with Int64.
 I hope that it is not too inefficient.
@@ -100,30 +100,3 @@
 skip :: Int64 -> Get ()
 skip n = Binary.getLazyByteString n >> return ()
 -- Binary.skip n
-
-warn :: String -> T ()
-warn text =
-   Cons $ return $ Report.Cons [text] (Right ())
-
-giveUp :: String -> T a
-giveUp text =
-   Cons $ return $ Report.Cons [] (Left text)
-
-try :: T a -> T (Either UserMessage a)
-try =
-   Cons . liftM (\r -> r{Report.result = Right (Report.result r)}) . decons
-
-
-{- |
-Wadler's force function
-
-'force' guarantees that the parser does not fail.
-Thus it makes parsing more lazy.
-However if the original parser fails though,
-then we get an unrecoverable /irrefutable pattern/ error on 'Just'.
--}
-force :: T a -> T a
-force p =
-   Cons $
-     do ~(Report.Cons w ~(Right x)) <- decons p
-        return (Report.Cons w (Right x))
diff --git a/src/Sound/MIDI/Parser/Class.hs b/src/Sound/MIDI/Parser/Class.hs
--- a/src/Sound/MIDI/Parser/Class.hs
+++ b/src/Sound/MIDI/Parser/Class.hs
@@ -1,39 +1,47 @@
 module Sound.MIDI.Parser.Class
-   (C, isEnd, getByte,
-    warn, giveUp, try,
-    force, zeroOrMore, zeroOrMoreInc, until, replicate, skip,
-    PossiblyIncomplete, UserMessage,
+   (EndCheck, isEnd,
+    C, getByte, skip,
+    warn, warnIf, warnIncomplete, Exc.giveUp, Exc.try,
+    until, zeroOrMore, zeroOrMoreInc, replicate,
+    emptyList, PossiblyIncomplete, UserMessage,
+    Fallible, Partial,
     {- for debugging
-    handleMsg, appendIncomplete,
+    absorbException, appendIncomplete,
     -}
     ) where
 
 
 import Sound.MIDI.Parser.Report (UserMessage)
+import qualified Sound.MIDI.Parser.Exception as Exc
+import qualified Control.Monad.Exception.Asynchronous as Async
+import qualified Control.Monad.Exception.Synchronous  as Sync
 
-import Control.Monad (liftM, liftM2, )
+import Control.Monad.Trans (lift, )
+import Control.Monad.State (StateT, )
+import Control.Monad (liftM, liftM2, when, )
 
 import Data.Word (Word8)
 
 import qualified Numeric.NonNegative.Wrapper as NonNeg
 
-import Sound.MIDI.Utility (mapSnd, )
-
 import Prelude hiding (replicate, until, )
 
 
 
-class Monad parser => C parser where
+class Monad parser => EndCheck parser where
    isEnd   :: parser Bool
-   getByte :: parser Word8
-   skip    :: NonNeg.Integer -> parser ()
-   warn    :: UserMessage -> parser ()
-   giveUp  :: UserMessage -> parser a
-   try     :: parser a -> parser (Either UserMessage a)
-   force   :: parser a -> parser a
 
+-- would be probably better placed in Parser.Status
+instance EndCheck parser => EndCheck (StateT st parser) where
+   isEnd = lift $ isEnd
 
 
+class EndCheck parser => C parser where
+   getByte :: Fallible parser Word8
+   skip    :: NonNeg.Integer -> Fallible parser ()
+   warn    :: UserMessage -> parser ()
+
+
 {- |
 @PossiblyIncomplete@ represents a value like a list
 that can be the result of an incomplete parse.
@@ -41,51 +49,60 @@
 
 It is not possible to merge this functionality in the parser monad,
 because then it is not possible to define monadic binding.
-
-In the future it should be replaced by
-'Control.Monad.Exception.Asynchronous.Exceptional'
-from the explicit-exception package.
 -}
-type PossiblyIncomplete a = (Maybe UserMessage, a)
+type PossiblyIncomplete a = Async.Exceptional UserMessage a
 
 
+type Fallible parser   = Sync.ExceptionalT UserMessage parser
+type Partial  parser a = parser (PossiblyIncomplete a)
 
-{-
-zeroOrMore   :: T s a -> T s [a]
-zeroOrMore p = force $ oneOrMore p `mplus` return []
 
-oneOrMore    :: T s a -> T s [a]
-oneOrMore p = liftM2 (:) p (zeroOrMore p)
+warnIf :: C parser => Bool -> UserMessage -> parser ()
+warnIf b msg = when b (warn msg)
+
+{- |
+Emit a warning if a value is said to be incomplete.
+Be careful using this function,
+because an incomplete value often means
+that subsequent parse actions will process data from the wrong position.
+Only use this function if you
+either know that the parse is complete also if the parsed value is incomplete
+or if there are no subsequent parse actions to run.
+
+This function cannot fail.
 -}
+warnIncomplete :: C parser => PossiblyIncomplete a -> parser a
+warnIncomplete ~(Async.Exceptional me a) =
+   do maybe (return ()) warn me
+      return a
 
+
 {- |
 This function will never fail.
 If the element parser fails somewhere,
 a prefix of the complete list is returned
 along with the error message.
 -}
-zeroOrMore :: C parser =>
-   parser a -> parser (PossiblyIncomplete [a])
+zeroOrMore :: EndCheck parser =>
+   Fallible parser a -> Partial parser [a]
 zeroOrMore p =
    let go =
-         force $ isEnd >>= \b ->
+         isEnd >>= \b ->
             if b
-              then return (Nothing, [])
-              else handleMsg
-                      (\errMsg -> (Just errMsg, []))
-                      (liftM2 (\ x ~(e,xs) -> (e,x:xs)) p go)
+              then return emptyList
+              else absorbException
+                      (liftM2 (\ x -> fmap (x:)) p (lift go))
    in  go
 
 
-zeroOrMoreInc :: C parser =>
-   parser (PossiblyIncomplete a) -> parser (PossiblyIncomplete [a])
+zeroOrMoreInc :: EndCheck parser =>
+   Partial (Fallible parser) a -> Partial parser [a]
 zeroOrMoreInc p =
    let go =
-         force $ isEnd >>= \b ->
+         isEnd >>= \b ->
             if b
-              then return (Nothing, [])
-              else handleMsg
-                      (\errMsg -> (Just errMsg, []))
+              then return emptyList
+              else absorbException
                       (appendIncomplete p go)
    in  go
 
@@ -95,23 +112,23 @@
 The terminating element is consumed by the parser
 but not appended to the result list.
 If the end of the input is reached without finding the terminating element,
-then an Incomplete exception (Just errorMessage) is signalled.
+then an Incomplete exception (Just errorMessage) is signaled.
 -}
-until :: C parser =>
-   (a -> Bool) -> parser a -> parser (PossiblyIncomplete [a])
+until :: EndCheck parser =>
+   (a -> Bool) -> Fallible parser a -> Partial parser [a]
 until c p =
    let go =
-         force $ isEnd >>= \b ->
+         isEnd >>= \b ->
             if b
               then
-                return (Just "Parser.until: unexpected end of input", [])
+                return $ Async.broken
+                   "Parser.until: unexpected end of input" []
               else
-                handleMsg
-                   (\errMsg -> (Just errMsg, [])) $
+                absorbException $
                    p >>= \x ->
                      if c x
-                       then return (Nothing, [])
-                       else liftM (mapSnd (x:)) go
+                       then return emptyList
+                       else liftM (fmap (x:)) (lift go)
    in  go
 
 
@@ -122,35 +139,36 @@
 replicate ::
    C parser =>
    NonNeg.Int ->
-   parser (PossiblyIncomplete a) ->
-   parser (PossiblyIncomplete [a])
+   Partial (Fallible parser) a ->
+   Partial parser [a]
 replicate m p =
    let go n =
-         force $
-            if n==0
-              then return (Nothing, [])
-              else handleMsg
-                      (\errMsg -> (Just errMsg, []))
-                      (appendIncomplete p (go (n-1)))
+         if n==0
+           then return emptyList
+           else absorbException
+                   (appendIncomplete p (go (n-1)))
    in  go m
 
+
+emptyList :: PossiblyIncomplete [a]
+emptyList = Async.pure []
+
 {- |
 The first parser may fail, but the second one must not.
 -}
 appendIncomplete ::
-   C parser =>
-   parser (PossiblyIncomplete a) ->
-   parser (PossiblyIncomplete [a]) ->
-   parser (PossiblyIncomplete [a])
+   Monad parser =>
+   Partial (Fallible parser) a ->
+   Partial parser [a] ->
+   Partial (Fallible parser) [a]
 appendIncomplete p ps =
-   do ~(me, x) <- p
-      liftM (mapSnd (x:)) $ force $
-         maybe ps (\_ -> return (me,[])) me
+   do ~(Async.Exceptional me x) <- p
+      lift $ liftM (fmap (x:)) $
+         maybe ps (\_ -> return (Async.Exceptional me [])) me
 
-handleMsg ::
-   C parser =>
-   (UserMessage -> a) -> parser a -> parser a
-handleMsg handler action =
-   liftM
-      (either handler id)
-      (try action)
+absorbException ::
+   Monad parser =>
+   Partial (Fallible parser) [a] ->
+   Partial parser [a]
+absorbException =
+   Sync.resolveT (\errMsg -> return $ Async.broken errMsg [])
diff --git a/src/Sound/MIDI/Parser/Exception.hs b/src/Sound/MIDI/Parser/Exception.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MIDI/Parser/Exception.hs
@@ -0,0 +1,24 @@
+{- |
+Handling of exceptions.
+-}
+module Sound.MIDI.Parser.Exception where
+
+import qualified Sound.MIDI.Parser.Report as Report
+-- import qualified Sound.MIDI.Parser.Warning as Warning
+
+import qualified Control.Monad.Exception.Synchronous as Sync
+
+
+type T m = Sync.ExceptionalT Report.UserMessage m
+
+
+run :: Monad m =>
+   T m a -> m (Sync.Exceptional Report.UserMessage a)
+run = Sync.runExceptionalT
+
+
+giveUp :: Monad m => String -> T m a
+giveUp = Sync.throwT
+
+try :: Monad m => T m a -> m (Sync.Exceptional Report.UserMessage a)
+try = Sync.tryT
diff --git a/src/Sound/MIDI/Parser/File.hs b/src/Sound/MIDI/Parser/File.hs
--- a/src/Sound/MIDI/Parser/File.hs
+++ b/src/Sound/MIDI/Parser/File.hs
@@ -5,10 +5,12 @@
 import qualified Sound.MIDI.Parser.Class as Parser
 import Sound.MIDI.Parser.Class (UserMessage, PossiblyIncomplete, )
 
-import Control.Monad.Reader (ReaderT(ReaderT, runReaderT), ask, liftM, lift, )
+import Control.Monad.Reader (ReaderT(runReaderT), ask, liftM, lift, )
 
 import qualified System.IO.Error as IOE
 import qualified Control.Exception as Exc
+import qualified Control.Monad.Exception.Asynchronous as Async
+import qualified Control.Monad.Exception.Synchronous  as Sync
 
 import qualified System.IO as IO
 import qualified Sound.MIDI.IO as MIO
@@ -21,16 +23,17 @@
 newtype T a = Cons {decons :: ReaderT IO.Handle IO a}
 
 
-runFile :: T a -> FilePath -> IO a
+runFile :: Parser.Fallible T a -> FilePath -> IO a
 runFile p name =
    Exc.bracket
       (IO.openBinaryFile name IO.ReadMode)
       IO.hClose
       (runHandle p)
 
-runHandle :: T a -> IO.Handle -> IO a
+runHandle :: Parser.Fallible T a -> IO.Handle -> IO a
 runHandle p h =
-   runReaderT (decons p) h
+   do exc <- runReaderT (decons (Sync.tryT p)) h
+      Sync.resolve (IOE.ioError . IOE.userError) (fmap return exc)
 
 
 
@@ -39,13 +42,13 @@
 we cannot know where the current file position is,
 we omit the @runIncompleteHandle@ variant.
 -}
-runIncompleteFile :: T (PossiblyIncomplete a) -> FilePath -> IO a
+runIncompleteFile :: Parser.Partial (Parser.Fallible T) a -> FilePath -> IO a
 runIncompleteFile p name =
    Exc.bracket
       (IO.openBinaryFile name IO.ReadMode)
       IO.hClose
       (\h ->
-          do (me,a) <- runHandle p h
+          do (Async.Exceptional me a) <- runHandle p h
              maybe (return ())
                  (\msg -> putStrLn $ "could not parse MIDI file completely: " ++ msg) me
              return a)
@@ -59,14 +62,16 @@
 fromIO :: (IO.Handle -> IO a) -> T a
 fromIO act = Cons $ lift . act =<< ask
 
-instance Parser.C T where
+fallibleFromIO :: (IO.Handle -> IO a) -> Parser.Fallible T a
+fallibleFromIO act =
+   Sync.ExceptionalT . Cons . lift .
+      fmap (Sync.mapException show . Sync.fromEither) . IOE.try . act
+          =<< lift (Cons ask)
+
+instance Parser.EndCheck T where
    isEnd   = fromIO IO.hIsEOF
-   getByte = fromIO $ liftM (fromIntegral . ord) . IO.hGetChar
-   skip n  = fromIO $ \h -> IO.hSeek h IO.RelativeSeek (NonNeg.toNumber n)
+
+instance Parser.C T where
+   getByte = fallibleFromIO $ liftM (fromIntegral . ord) . IO.hGetChar
+   skip n  = fallibleFromIO $ \h -> IO.hSeek h IO.RelativeSeek (NonNeg.toNumber n)
    warn    = Cons . lift . (\msg -> putStrLn ("warning: " ++ msg))
-   giveUp  = Cons . lift . IOE.ioError . IOE.userError
-   try p   =
-      Cons $ ReaderT $ \h ->
-         liftM (either (Left . show) Right) $
-         IOE.try $ runReaderT (decons p) h
-   force p = p
diff --git a/src/Sound/MIDI/Parser/Primitive.hs b/src/Sound/MIDI/Parser/Primitive.hs
--- a/src/Sound/MIDI/Parser/Primitive.hs
+++ b/src/Sound/MIDI/Parser/Primitive.hs
@@ -24,20 +24,20 @@
 {- |
 'getByte' gets a single byte from the input.
 -}
-getByte :: Parser.C parser => parser Word8
+getByte :: Parser.C parser => Parser.Fallible parser Word8
 getByte = Parser.getByte
 
 
 {- |
 @getN n@ returns n characters (bytes) from the input.
 -}
-getN :: Parser.C parser => NonNeg.Int -> parser ByteList
+getN :: Parser.C parser => NonNeg.Int -> Parser.Fallible parser ByteList
 getN n = replicateM (NonNeg.toNumber n) getByte
 
-getString :: Parser.C parser => NonNeg.Integer -> parser String
+getString :: Parser.C parser => NonNeg.Integer -> Parser.Fallible parser String
 getString n = liftM listCharFromByte (getBigN n)
 
-getBigN :: Parser.C parser => NonNeg.Integer -> parser ByteList
+getBigN :: Parser.C parser => NonNeg.Integer -> Parser.Fallible parser ByteList
 getBigN n =
    sequence $
    Bit.replicateBig
@@ -51,22 +51,22 @@
 4-byte numbers from the input (respectively), convert the base-256 data
 into a single number, and return.
 -}
-get1 :: Parser.C parser => parser Int
+get1 :: Parser.C parser => Parser.Fallible parser Int
 get1 = liftM fromIntegral getByte
 
-getNByteInt :: Parser.C parser => NonNeg.Int -> parser Int
+getNByteInt :: Parser.C parser => NonNeg.Int -> Parser.Fallible parser Int
 getNByteInt n =
    liftM Bit.fromBytes (replicateM (NonNeg.toNumber n) get1)
 
-get2, get3, get4 :: Parser.C parser => parser Int
+get2, get3, get4 :: Parser.C parser => Parser.Fallible parser Int
 get2 = getNByteInt 2
 get3 = getNByteInt 3
 get4 = getNByteInt 4
 
-getByteAsCardinal :: Parser.C parser => parser NonNeg.Integer
+getByteAsCardinal :: Parser.C parser => Parser.Fallible parser NonNeg.Integer
 getByteAsCardinal = liftM fromIntegral getByte
 
-getNByteCardinal :: Parser.C parser => NonNeg.Int -> parser NonNeg.Integer
+getNByteCardinal :: Parser.C parser => NonNeg.Int -> Parser.Fallible parser NonNeg.Integer
 getNByteCardinal n =
    liftM Bit.fromBytes (replicateM (NonNeg.toNumber n) getByteAsCardinal)
 
@@ -79,7 +79,7 @@
 If it's @0@, that byte is the last one.
 'getVar' gets a variable-length quantity from the input.
 -}
-getVar :: Parser.C parser => parser NonNeg.Integer
+getVar :: Parser.C parser => Parser.Fallible parser NonNeg.Integer
 getVar =
    liftM (Bit.fromBase (2^(7::Int)) . map fromIntegral) getVarBytes
 
@@ -87,7 +87,7 @@
 The returned list contains only bytes with the most significant bit cleared.
 These are digits of a 128-ary number.
 -}
-getVarBytes :: Parser.C parser => parser [Word8]
+getVarBytes :: Parser.C parser => Parser.Fallible parser [Word8]
 getVarBytes =
    do
       digit <- getByte
@@ -96,12 +96,12 @@
         else return [digit]
 
 
-getEnum :: (Parser.C parser, Enum enum, Bounded enum) => parser enum
+getEnum :: (Parser.C parser, Enum enum, Bounded enum) => Parser.Fallible parser enum
 getEnum = makeEnum =<< get1
 
-makeEnum :: (Parser.C parser, Enum enum, Bounded enum) => Int -> parser enum
+makeEnum :: (Parser.C parser, Enum enum, Bounded enum) => Int -> Parser.Fallible parser enum
 makeEnum n =
-   let go :: (Parser.C parser, Enum a) => a -> a -> parser a
+   let go :: (Parser.C parser, Enum a) => a -> a -> Parser.Fallible parser a
        go lower upper =
           if fromEnum lower <= n && n <= fromEnum upper
             then return (toEnum n)
diff --git a/src/Sound/MIDI/Parser/Restricted.hs b/src/Sound/MIDI/Parser/Restricted.hs
--- a/src/Sound/MIDI/Parser/Restricted.hs
+++ b/src/Sound/MIDI/Parser/Restricted.hs
@@ -4,13 +4,14 @@
 where the length of a part is fixed by a length specification.
 -}
 module Sound.MIDI.Parser.Restricted
-   (T(..), run, ) where
+   (T(..), run, runFallible, ) where
 
 import qualified Sound.MIDI.Parser.Class as Parser
 
-import Control.Monad.State
-   (StateT(StateT, runStateT), mapStateT,
-    get, put, liftM, lift, when, )
+import qualified Control.Monad.Exception.Synchronous  as Sync
+import qualified Control.Monad.Trans as Trans
+import qualified Control.Monad.State as State
+import Control.Monad.State (StateT(runStateT), gets, get, put, when, )
 
 import qualified Numeric.NonNegative.Wrapper as NonNeg
 
@@ -21,13 +22,21 @@
    NonNeg.Integer -> T parser a -> parser a
 run maxLen p =
    do (x,remaining) <- runStateT (decons p) maxLen
-      Parser.force $ when
+      Parser.warnIf
          (remaining>0)
-         (Parser.warn ("unparsed bytes left in part (" ++ show remaining ++ " bytes)"))
+         ("unparsed bytes left in part (" ++ show remaining ++ " bytes)")
       return x
 
+runFallible :: Parser.C parser =>
+   NonNeg.Integer -> Parser.Fallible (T parser) a -> Parser.Fallible parser a
+runFallible len = Sync.mapExceptionalT (run len)
 
 
+lift :: Monad parser => Parser.Fallible parser a -> Parser.Fallible (T parser) a
+lift = Sync.mapExceptionalT State.lift
+
+
+
 newtype T parser a =
    Cons {decons :: StateT NonNeg.Integer parser a}
 
@@ -35,12 +44,28 @@
    return = Cons . return
    x >>= y = Cons $ decons . y =<< decons x
 
-instance Parser.C parser => Parser.C (T parser) where
+instance Trans.MonadTrans T where
+   lift = Cons . State.lift
+
+
+getRemaining :: Monad parser => Parser.Fallible (T parser) NonNeg.Integer
+getRemaining = Trans.lift $ Cons get
+
+putRemaining :: Monad parser => NonNeg.Integer -> Parser.Fallible (T parser) ()
+putRemaining = Trans.lift . Cons . put
+
+
+instance Parser.EndCheck parser => Parser.EndCheck (T parser) where
    isEnd =
-     Cons $ get >>= \remaining ->
-       if remaining==0 then return True else lift Parser.isEnd
+     {- if remaining>0 then we do not check
+        whether there are actually more bytes in the stream
+        because that will be catched anyway on the next getByte or skip -}
+     Cons (gets (0==))
+--       if remaining==0 then return True else lift Parser.isEnd
+
+instance Parser.C parser => Parser.C (T parser) where
    getByte =
-     Cons $ get >>= \remaining ->
+     getRemaining >>= \remaining ->
        do when (remaining==0)
              (lift $ Parser.giveUp "unexpected end of part")
 {- in principle not necessary, because Parser.getByte must check for remaining bytes
@@ -48,23 +73,14 @@
           when end
              (lift $ Parser.giveUp "part longer than container")
 -}
-          put (remaining-1)
+          putRemaining (remaining-1)
           lift Parser.getByte
+
    skip n =
-     Cons $ get >>= \remaining ->
+     getRemaining >>= \remaining ->
        if n>remaining
          then lift $ Parser.giveUp "skip beyond end of part"
-         else put (remaining-n) >> lift (Parser.skip n)
-   warn   = Cons . lift . Parser.warn
-   -- giveUp = Cons . lift . giveUp
-   giveUp errMsg =
-      Cons $ StateT $ \remain ->
-         Parser.skip remain >> Parser.giveUp errMsg
-   try (Cons st) =
-      Cons $ StateT $ \remain0 ->
-         liftM (either
-                 (\errMsg -> (Left errMsg, 0))
-                 (\(x,remain1) -> (Right x, remain1))) $
-         Parser.try (runStateT st remain0)
-   force (Cons st) =
-      Cons $ mapStateT Parser.force st
+         else putRemaining (remaining-n) >>
+              lift (Parser.skip n)
+
+   warn = Cons . Trans.lift . Parser.warn
diff --git a/src/Sound/MIDI/Parser/State.hs b/src/Sound/MIDI/Parser/State.hs
deleted file mode 100644
--- a/src/Sound/MIDI/Parser/State.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{- |
-Very similar to "Sound.MIDI.Parser".
--}
-module Sound.MIDI.Parser.State
-   (T, zeroOrMore, StateT(..), ) where
-
-import qualified Sound.MIDI.Parser.Class as Parser
-
-import Control.Monad.State (StateT(..), mapStateT, liftM, liftM2, lift, )
-
-
-type T st parser = StateT st parser
-
-
-force :: Parser.C parser =>
-   T st parser a -> T st parser a
-force = mapStateT Parser.force
-
-zeroOrMore :: Parser.C parser =>
-   T st parser a -> T st parser (Parser.PossiblyIncomplete [a])
-zeroOrMore p =
-   let go =
-         force $ isEnd >>= \b ->
-            if b
-              then return (Nothing, [])
-              else handleMsg
-                      (\errMsg -> (Just errMsg, []))
-                      (liftM2 (\ x ~(e,xs) -> (e,x:xs)) p go)
-   in  go
-
-{-
-zeroOrMore :: T st [byte] a -> T st [byte] [a]
-zeroOrMore p =
-   let go =
-         isEnd >>= \b ->
-            if b
-              then return []
-              else liftM2 (:) p go
-   in  go
--}
-
-{- |
-In case of an exception, the handler restores the old state.
--}
-handleMsg :: Parser.C parser =>
-   (Parser.UserMessage -> a) -> T st parser a -> T st parser a
-handleMsg handler action =
-   StateT $ \s ->
-      liftM
-         (either (\e -> (handler e, s)) id)
-         (Parser.try (runStateT action s))
-
-
-isEnd :: Parser.C parser =>
-   T st parser Bool
-isEnd = lift $ Parser.isEnd
diff --git a/src/Sound/MIDI/Parser/Status.hs b/src/Sound/MIDI/Parser/Status.hs
--- a/src/Sound/MIDI/Parser/Status.hs
+++ b/src/Sound/MIDI/Parser/Status.hs
@@ -4,12 +4,13 @@
 The running state consists of a message code and the message channel.
 -}
 module Sound.MIDI.Parser.Status
-   (T, Status, set, get, run, State.lift,
+   (T, Status, set, get, run, lift,
     Channel, fromChannel,   toChannel, ) where
 
-import qualified Sound.MIDI.Parser.State as ParserState
+import qualified Sound.MIDI.Parser.Class as Parser
 
-import Control.Monad.State (evalStateT, )
+import qualified Control.Monad.Exception.Synchronous  as Sync
+import Control.Monad.State (StateT, evalStateT, )
 import qualified Control.Monad.State as State
 
 import Sound.MIDI.Utility (checkRange, )
@@ -25,19 +26,23 @@
 the parser must keep track of the type and channel of the most recent MIDI Event.
 This is done by managing a 'Status' in the parser.
 -}
-type T parser a = ParserState.T Status parser a
+type T parser = StateT Status parser
 
 type Status = Maybe (Int,Channel)
 
 
-set :: Monad parser => Status -> T parser ()
-set = State.put
+set :: Monad parser => Status -> Parser.Fallible (T parser) ()
+set = State.lift . State.put
 
-get :: Monad parser => T parser Status
-get = State.get
+get :: Monad parser => Parser.Fallible (T parser) Status
+get = State.lift State.get
 
 run :: Monad parser => T parser a -> parser a
 run = flip evalStateT Nothing
+
+
+lift :: Monad parser => Parser.Fallible parser a -> Parser.Fallible (T parser) a
+lift = Sync.mapExceptionalT State.lift
 
 
 -- * Channel definition
diff --git a/src/Sound/MIDI/Parser/Stream.hs b/src/Sound/MIDI/Parser/Stream.hs
--- a/src/Sound/MIDI/Parser/Stream.hs
+++ b/src/Sound/MIDI/Parser/Stream.hs
@@ -1,17 +1,22 @@
 module Sound.MIDI.Parser.Stream
    (T(..), run, runIncomplete, runPartial,
     ByteList(..),
-    PossiblyIncomplete, UserMessage, processReport, ) where
+    PossiblyIncomplete, UserMessage, ) where
 
 
 import Control.Monad.State
    (State(runState), evalState,
     get, put, liftM, when, )
+import Control.Monad.Trans (lift, )
 
 import qualified Sound.MIDI.Parser.Report as Report
 import qualified Sound.MIDI.Parser.Class as Parser
 import Sound.MIDI.Parser.Class (UserMessage, PossiblyIncomplete, )
+import qualified Sound.MIDI.Parser.Exception as Exception
+import qualified Sound.MIDI.Parser.Warning   as Warning
 
+-- import qualified Control.Monad.Exception.Synchronous as Sync
+
 import qualified Sound.MIDI.IO as MIO
 
 import Data.Word (Word8)
@@ -27,20 +32,22 @@
 Instead of using Report and write the monad instance manually,
 we could also use WriterT monad for warnings and ErrorT monad for failure handling.
 -}
-newtype T str a = Cons {decons :: State str (Report.T a)}
+newtype T str a =
+   Cons {decons :: Warning.T (State str) a}
 
 
 
-runPartial :: T str a -> str -> (Report.T a, str)
+runPartial :: Parser.Fallible (T str) a -> str -> (Report.T a, str)
 runPartial parser input =
-   flip runState input (decons parser)
+   flip runState input $ Warning.run $ decons $ Exception.run parser
 
-run :: ByteStream str => T str a -> str -> Report.T a
+run :: ByteStream str => Parser.Fallible (T str) a -> str -> Report.T a
 run parser input =
-   flip evalState input $ decons $
+   flip evalState input $ Warning.run $ decons $ Exception.run $
       (do a <- parser
-          end <- Parser.isEnd
-          Parser.force $ when (not end) (warn "unparsed data left over")
+          lift $
+             Parser.isEnd >>= \end ->
+                Parser.warnIf (not end) "unparsed data left over"
           return a)
 
 {- |
@@ -49,36 +56,23 @@
 and thus further parsing is not possible.
 -}
 runIncomplete :: ByteStream str =>
-   T str (PossiblyIncomplete a) -> str -> Report.T a
+   Parser.Partial (Parser.Fallible (T str)) a -> str -> Report.T a
 runIncomplete parser input =
    flip run input $
-      do (me,x) <- parser
-         Parser.force $ maybe (return ()) warn me
-         return x
+      lift . Parser.warnIncomplete =<< parser
 
 
 
 fromState :: State str a -> T str a
 fromState p =
-   Cons $ liftM (\a -> Report.Cons [] (Right a)) p
+   Cons $ lift p
 
 
 instance Monad (T str) where
-   return x = fromState $ return x
-   x >>= y  = Cons $
-      decons x >>= \ a ->
-         case Report.result a of
-            Left err -> return (Report.Cons (Report.warnings a) (Left err))
-            Right ar ->
-               liftM (\b ->
---                  b{Report.warnings = Report.warnings a ++ Report.warnings b}
-                  -- more lazy
-                  Report.Cons
-                     (Report.warnings a ++ Report.warnings b)
-                     (Report.result b)
-                  ) $
-               decons (y ar)
+   return = Cons . return
+   x >>= y = Cons $ decons . y =<< decons x
 
+
 class ByteStream str where
    switchL :: a -> (Word8 -> str -> a) -> str -> a
    drop :: NonNeg.Integer -> str -> str
@@ -92,67 +86,27 @@
          _ -> n
    drop n (ByteList xs) = ByteList $ List.genericDrop n xs
 
-instance ByteStream str => Parser.C (T str) where
+instance ByteStream str => Parser.EndCheck (T str) where
    isEnd = fromState $ liftM (switchL True (\ _ _ -> False)) get
+
+instance ByteStream str => Parser.C (T str) where
    getByte =
       switchL
-         (giveUp "unexpected end of data")
-         (\s ss -> fromState (put ss) >> return s) =<<
-      fromState get
+         (Parser.giveUp "unexpected end of data")
+         (\s ss -> lift (fromState (put ss)) >> return s) =<<
+      lift (fromState get)
+
 {-
    skip n = sequence_ (genericReplicate n Parser.getByte)
 -}
    skip n = when (n>0) $
-      do s <- fromState get
+      do s <- lift $ fromState get
          switchL
             (Parser.giveUp "skip past end of part")
-            (\ _ rest -> fromState $ put rest)
+            (\ _ rest -> lift $ fromState $ put rest)
             (drop (n-1) s)
-   warn   = warn
-   giveUp = giveUp
-   try    = try
-   force  = force
 
-
-warn :: String -> T str ()
-warn text =
-   Cons $ return $ Report.Cons [text] (Right ())
-
-giveUp :: String -> T str a
-giveUp text =
-   Cons $ return $ Report.Cons [] (Left text)
-
-try :: T str a -> T str (Either UserMessage a)
-try =
-   -- more lazy
-   Cons .
-   liftM (\r -> Report.Cons (Report.warnings r) (Right (Report.result r))) .
-   -- liftM (\r -> r{Report.result = Right (Report.result r)}) .
-   decons
-
-
-{- |
-Wadler's force function
-
-'force' guarantees that the parser does not fail.
-Thus it makes parsing more lazy.
-However if the original parser fails though,
-then we get an unrecoverable /irrefutable pattern/ error on 'Just'.
--}
-force :: T str a -> T str a
-force p =
-   Cons $
-     do ~(Report.Cons w ~(Right x)) <- decons p
-        return (Report.Cons w (Right x))
-
-
-{- |
-Emit all Report.warnings and throw the error from the report.
--}
-processReport :: Report.T a -> T str a
-processReport report =
-   mapM_ warn (Report.warnings report) >>
-   either giveUp return (Report.result report)
+   warn = Cons . Warning.warn
 
 
 {-
diff --git a/src/Sound/MIDI/Parser/Warning.hs b/src/Sound/MIDI/Parser/Warning.hs
new file mode 100644
--- /dev/null
+++ b/src/Sound/MIDI/Parser/Warning.hs
@@ -0,0 +1,28 @@
+{- |
+Handling of warnings.
+-}
+module Sound.MIDI.Parser.Warning where
+
+import qualified Sound.MIDI.Parser.Report as Report
+
+import qualified Control.Monad.Exception.Synchronous as Sync
+import qualified Control.Monad.Writer as Writer
+
+
+type T m = Writer.WriterT [Report.UserMessage] m
+
+
+run :: Monad m =>
+   T m (Sync.Exceptional Report.UserMessage a) -> m (Report.T a)
+run act =
+   do (exc,warns) <- Writer.runWriterT act
+      return $ Report.Cons warns (Sync.toEither exc)
+
+{-
+run :: Monad m =>
+   T m a -> m (a, [Report.UserMessage])
+run = Writer.runWriterT
+-}
+
+warn :: Monad m => String -> T m ()
+warn text = Writer.tell [text]
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -28,6 +28,7 @@
 import qualified Data.List as List
 
 import Sound.MIDI.Utility (viewR, dropMatch, )
+import Control.Monad.Trans (lift, )
 import Control.Monad (when, )
 
 import System.Random (mkStdGen, randomR, )
@@ -150,7 +151,7 @@
 lazinessZeroOrMoreByteList :: NonNeg.Int -> Int -> Bool
 lazinessZeroOrMoreByteList pos byte =
    let result =
-          Report.result $ StreamParser.runIncomplete (Parser.zeroOrMore Parser.getByte) $
+          Report.result $ StreamParser.runIncomplete (lift (Parser.zeroOrMore Parser.getByte)) $
           StreamParser.ByteList $ repeat $ fromIntegral byte
        char = show result !! mod (NonNeg.toNumber pos) 1000
    in  char == char