{- | 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