State.hs

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