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

import Sound.MIDI.Parser.Status (Channel)

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

import qualified Data.Monoid.HT as MonoidHT
import Data.Monoid (Monoid, mempty, mappend, mconcat, )
import Data.Semigroup (Semigroup, sconcat, (<>), )
import Sound.MIDI.Monoid (genAppend, genConcat, nonEmptyConcat, )


data Uncompressed = Uncompressed

newtype Compressed = Compressed Status
type Status = Maybe (Int,Channel)

{- |
'status' can be 'Uncompressed' for files ignoring the running status
or 'Compressed' for files respecting the running status.
-}
newtype T compress writer = Cons {forall compress writer. T compress writer -> T compress writer
decons :: State.T compress writer}


instance Semigroup writer => Semigroup (T compress writer) where
   Cons T compress writer
x <> :: T compress writer -> T compress writer -> T compress writer
<> Cons T compress writer
y = forall compress writer. T compress writer -> T compress writer
Cons forall a b. (a -> b) -> a -> b
$ T compress writer
xforall a. Semigroup a => a -> a -> a
<>T compress writer
y
   sconcat :: NonEmpty (T compress writer) -> T compress writer
sconcat = forall m a. Semigroup m => (m -> a) -> (a -> m) -> NonEmpty a -> a
nonEmptyConcat forall compress writer. T compress writer -> T compress writer
Cons forall compress writer. T compress writer -> T compress writer
decons

instance Monoid writer => Monoid (T compress writer) where
   mempty :: T compress writer
mempty = forall compress writer. T compress writer -> T compress writer
Cons forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty
   mappend :: T compress writer -> T compress writer -> T compress writer
mappend = forall m a. Monoid m => (m -> a) -> (a -> m) -> a -> a -> a
genAppend forall compress writer. T compress writer -> T compress writer
Cons forall compress writer. T compress writer -> T compress writer
decons
   mconcat :: [T compress writer] -> T compress writer
mconcat = forall m a. Monoid m => (m -> a) -> (a -> m) -> [a] -> a
genConcat forall compress writer. T compress writer -> T compress writer
Cons forall compress writer. T compress writer -> T compress writer
decons


class Compression compress where
   {- |
   Given a writer that emits a status, generate a stateful writer,
   that decides whether to run the status emittor.
   -}
   change :: (Monoid writer) => (Int, Channel) -> writer -> T compress writer
   initState :: compress

instance Compression Uncompressed where
   change :: forall writer.
Monoid writer =>
(Int, Channel) -> writer -> T Uncompressed writer
change (Int, Channel)
_ writer
emit = forall compress writer. T compress writer -> T compress writer
Cons forall a b. (a -> b) -> a -> b
$ forall a s. a -> T s a
State.pure writer
emit
   initState :: Uncompressed
initState = Uncompressed
Uncompressed

instance Compression Compressed where
   change :: forall writer.
Monoid writer =>
(Int, Channel) -> writer -> T Compressed writer
change (Int, Channel)
x writer
emit =
      forall compress writer. T compress writer -> T compress writer
Cons forall a b. (a -> b) -> a -> b
$
      forall s a. (s -> (a, s)) -> T s a
State.Cons forall a b. (a -> b) -> a -> b
$ \(Compressed Maybe (Int, Channel)
my) ->
         let mx :: Maybe (Int, Channel)
mx = forall a. a -> Maybe a
Just (Int, Channel)
x
         in  (forall m. Monoid m => Bool -> m -> m
MonoidHT.when (Maybe (Int, Channel)
mxforall a. Eq a => a -> a -> Bool
/=Maybe (Int, Channel)
my) writer
emit, Maybe (Int, Channel) -> Compressed
Compressed Maybe (Int, Channel)
mx)
   initState :: Compressed
initState = Maybe (Int, Channel) -> Compressed
Compressed forall a. Maybe a
Nothing

clear :: (Compression compress, Monoid writer) => T compress writer
clear :: forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer
clear = forall compress writer. T compress writer -> T compress writer
Cons forall a b. (a -> b) -> a -> b
$ forall a s. Monoid a => s -> T s a
State.put forall compress. Compression compress => compress
initState


instance Trans.C (T compress) where
   lift :: forall m. Monoid m => m -> T compress m
lift = forall writer compress.
Monoid writer =>
writer -> T compress writer
fromWriter

fromWriter :: (Monoid writer) => writer -> T compress writer
fromWriter :: forall writer compress.
Monoid writer =>
writer -> T compress writer
fromWriter = forall compress writer. T compress writer -> T compress writer
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
lift

toWriter :: (Compression compress, Monoid writer) => T compress writer -> writer
toWriter :: forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
toWriter = forall s a. s -> T s a -> a
State.evaluate forall compress. Compression compress => compress
initState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compress writer. T compress writer -> T compress writer
decons

toWriterWithStatus :: (Monoid writer) => T Compressed writer -> writer
toWriterWithStatus :: forall writer. Monoid writer => T Compressed writer -> writer
toWriterWithStatus = forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
toWriter

toWriterWithoutStatus :: (Monoid writer) => T Uncompressed writer -> writer
toWriterWithoutStatus :: forall writer. Monoid writer => T Uncompressed writer -> writer
toWriterWithoutStatus = forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
toWriter