module Sound.MIDI.Writer.Status (
   module Sound.MIDI.Writer.Status,
   lift,
   ) where

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

import Sound.MIDI.Parser.Status (Channel)

import qualified Data.Monoid.State       as State
import qualified Data.Monoid.Reader      as Reader
import qualified Data.Monoid.Transformer as Trans
import Data.Monoid.Transformer (lift, )

import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Sound.MIDI.Monoid (genAppend, genConcat, )


type Status = Maybe (Int,Channel)

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


instance Monoid writer => Monoid (T writer) where
   mempty = Cons $ mempty
   mappend = genAppend Cons decons
   mconcat = genConcat Cons decons

{- |
Given a writer that emits a status, generate a stateful writer,
that decides whether to run the status emittor.
-}
change :: (Monoid writer) => Status -> writer -> T writer
change x emit =
   Cons $
   Reader.Cons $ \b ->
   State.Cons $ \my ->
      let mx = Just x
      in  (if not b || mx/=my then emit else mempty, mx)

clear :: (Monoid writer) => T writer
clear = Cons $ lift $ State.put Nothing


instance Trans.C T where
   lift = fromWriter

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

toWriter :: (Monoid writer) => Bool -> T writer -> writer
toWriter withStatus =
   State.evaluate Nothing . flip Reader.run withStatus . decons

toWriterWithStatus :: (Monoid writer) => T writer -> writer
toWriterWithStatus = toWriter True

toWriterWithoutStatus :: (Monoid writer) => T writer -> writer
toWriterWithoutStatus = toWriter False