module Sound.MIDI.Parser.Stream
(T(..), run, runIncomplete, runPartial,
ByteList(..),
PossiblyIncomplete, UserMessage, ) where
import Control.Monad.Trans.State
(State, runState, evalState, get, put, )
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, when, )
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 Sound.MIDI.IO as MIO
import Data.Word (Word8)
import qualified Data.List as List
import qualified Numeric.NonNegative.Wrapper as NonNeg
import Prelude hiding (replicate, until, drop, )
newtype T str a =
Cons {decons :: Warning.T (State str) a}
runPartial :: Parser.Fallible (T str) a -> str -> (Report.T a, str)
runPartial parser input =
flip runState input $ Warning.run $ decons $ Exception.run parser
run :: ByteStream str => Parser.Fallible (T str) a -> str -> Report.T a
run parser input =
flip evalState input $ Warning.run $ decons $ Exception.run $
(do a <- parser
lift $
Parser.isEnd >>= \end ->
Parser.warnIf (not end) "unparsed data left over"
return a)
runIncomplete :: ByteStream str =>
Parser.Partial (Parser.Fallible (T str)) a -> str -> Report.T a
runIncomplete parser input =
flip run input $
lift . Parser.warnIncomplete =<< parser
fromState :: State str a -> T str a
fromState p =
Cons $ lift p
instance Monad (T str) where
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
newtype ByteList = ByteList MIO.ByteList
instance ByteStream ByteList where
switchL n j (ByteList xss) =
case xss of
(x:xs) -> j x (ByteList xs)
_ -> n
drop n (ByteList xs) = ByteList $ List.genericDrop n xs
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
(Parser.giveUp "unexpected end of data")
(\s ss -> lift (fromState (put ss)) >> return s) =<<
lift (fromState get)
skip n = when (n>0) $
do s <- lift $ fromState get
switchL
(Parser.giveUp "skip past end of part")
(\ _ rest -> lift $ fromState $ put rest)
(drop (n1) s)
warn = Cons . Warning.warn