module Sound.MIDI.Parser.Class (C, isEnd, getByte, warn, giveUp, try, force, zeroOrMore, zeroOrMoreInc, until, replicate, skip, PossiblyIncomplete, UserMessage, {- for debugging handleMsg, appendIncomplete, -} ) where import Sound.MIDI.Parser.Report (UserMessage) import Control.Monad (liftM, liftM2, ) 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 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 {- | @PossiblyIncomplete@ represents a value like a list that can be the result of an incomplete parse. The case of an incomplete parse is indicated by @Just message@. 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) {- 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) -} {- | 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 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 zeroOrMoreInc :: C parser => parser (PossiblyIncomplete a) -> parser (PossiblyIncomplete [a]) zeroOrMoreInc p = let go = force $ isEnd >>= \b -> if b then return (Nothing, []) else handleMsg (\errMsg -> (Just errMsg, [])) (appendIncomplete p go) in go {- | Parse until an element is found, which matches a condition. 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. -} until :: C parser => (a -> Bool) -> parser a -> parser (PossiblyIncomplete [a]) until c p = let go = force $ isEnd >>= \b -> if b then return (Just "Parser.until: unexpected end of input", []) else handleMsg (\errMsg -> (Just errMsg, [])) $ p >>= \x -> if c x then return (Nothing, []) else liftM (mapSnd (x:)) go in go {- | This function will never fail. It may however return a list that is shorter than requested. -} replicate :: C parser => NonNeg.Int -> parser (PossiblyIncomplete a) -> parser (PossiblyIncomplete [a]) replicate m p = let go n = force $ if n==0 then return (Nothing, []) else handleMsg (\errMsg -> (Just errMsg, [])) (appendIncomplete p (go (n-1))) in go m {- | The first parser may fail, but the second one must not. -} appendIncomplete :: C parser => parser (PossiblyIncomplete a) -> parser (PossiblyIncomplete [a]) -> parser (PossiblyIncomplete [a]) appendIncomplete p ps = do ~(me, x) <- p liftM (mapSnd (x:)) $ force $ maybe ps (\_ -> return (me,[])) me handleMsg :: C parser => (UserMessage -> a) -> parser a -> parser a handleMsg handler action = liftM (either handler id) (try action)