module Sound.MIDI.Writer.Status where

-- import qualified Sound.MIDI.Writer.Basic as Writer

import Sound.MIDI.Parser.Status (Channel)

import Control.Monad.Trans.State  (StateT, evalStateT, get, put, )
import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask, )
import Control.Monad.Trans  (MonadTrans, lift, )


type Status = Maybe (Int,Channel)

{- |
The ReaderT Bool handles
whether running status should be respected (True) or ignored (False).
-}
newtype T writer a =
   Cons {decons :: ReaderT Bool (StateT (Maybe Status) writer) a}


instance Monad writer => Monad (T writer) where
   return = Cons . return
   x >>= y = Cons $ decons . y =<< decons x

-- | returns 'True' if status must be submitted (e.g. because it was changed)
change :: (Monad writer) => Status -> T writer Bool
change x = Cons $
   do b <- ask
      if not b
        then return True
        else
           lift $
           let mx = Just x
           in  do my <- get
                  put mx
                  return (mx/=my)

clear :: (Monad writer) => T writer ()
clear = Cons $ lift $ put Nothing


instance MonadTrans T where
   lift = fromWriter

fromWriter :: (Monad writer) => writer a -> T writer a
fromWriter = Cons . lift . lift

toWriter :: (Monad writer) => Bool -> T writer a -> writer a
toWriter withStatus w =
   evalStateT (runReaderT (decons w) withStatus) Nothing

toWriterWithStatus :: (Monad writer) => T writer a -> writer a
toWriterWithStatus = toWriter True

toWriterWithoutStatus :: (Monad writer) => T writer a -> writer a
toWriterWithoutStatus = toWriter False