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)