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, 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
   <> :: T compress writer -> T compress writer -> T compress writer
(<>) = (T compress writer -> T compress writer)
-> (T compress writer -> T compress writer)
-> T compress writer
-> T compress writer
-> T compress writer
forall m a. Semigroup m => (m -> a) -> (a -> m) -> a -> a -> a
genAppend T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
decons
   sconcat :: NonEmpty (T compress writer) -> T compress writer
sconcat = (T compress writer -> T compress writer)
-> (T compress writer -> T compress writer)
-> NonEmpty (T compress writer)
-> T compress writer
forall m a. Semigroup m => (m -> a) -> (a -> m) -> NonEmpty a -> a
nonEmptyConcat T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
decons

instance Monoid writer => Monoid (T compress writer) where
   mempty :: T compress writer
mempty = T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons (T compress writer -> T compress writer)
-> T compress writer -> T compress writer
forall a b. (a -> b) -> a -> b
$ T compress writer
forall a. Monoid a => a
mempty
   mconcat :: [T compress writer] -> T compress writer
mconcat = (T compress writer -> T compress writer)
-> (T compress writer -> T compress writer)
-> [T compress writer]
-> T compress writer
forall m a. Monoid m => (m -> a) -> (a -> m) -> [a] -> a
genConcat T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons T compress writer -> T compress writer
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 = T Uncompressed writer -> T Uncompressed writer
forall compress writer. T compress writer -> T compress writer
Cons (T Uncompressed writer -> T Uncompressed writer)
-> T Uncompressed writer -> T Uncompressed writer
forall a b. (a -> b) -> a -> b
$ writer -> T Uncompressed writer
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 =
      T Compressed writer -> T Compressed writer
forall compress writer. T compress writer -> T compress writer
Cons (T Compressed writer -> T Compressed writer)
-> T Compressed writer -> T Compressed writer
forall a b. (a -> b) -> a -> b
$
      (Compressed -> (writer, Compressed)) -> T Compressed writer
forall s a. (s -> (a, s)) -> T s a
State.Cons ((Compressed -> (writer, Compressed)) -> T Compressed writer)
-> (Compressed -> (writer, Compressed)) -> T Compressed writer
forall a b. (a -> b) -> a -> b
$ \(Compressed Maybe (Int, Channel)
my) ->
         let mx :: Maybe (Int, Channel)
mx = (Int, Channel) -> Maybe (Int, Channel)
forall a. a -> Maybe a
Just (Int, Channel)
x
         in  (Bool -> writer -> writer
forall m. Monoid m => Bool -> m -> m
MonoidHT.when (Maybe (Int, Channel)
mxMaybe (Int, Channel) -> Maybe (Int, Channel) -> Bool
forall 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 Maybe (Int, Channel)
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 = T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons (T compress writer -> T compress writer)
-> T compress writer -> T compress writer
forall a b. (a -> b) -> a -> b
$ compress -> T compress writer
forall a s. Monoid a => s -> T s a
State.put compress
forall compress. Compression compress => compress
initState


instance Trans.C (T compress) where
   lift :: forall m. Monoid m => m -> T compress m
lift = m -> T compress m
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 = T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
Cons (T compress writer -> T compress writer)
-> (writer -> T compress writer) -> writer -> T compress writer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. writer -> T compress writer
forall m. Monoid m => m -> T compress m
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 = compress -> T compress writer -> writer
forall s a. s -> T s a -> a
State.evaluate compress
forall compress. Compression compress => compress
initState (T compress writer -> writer)
-> (T compress writer -> T compress writer)
-> T compress writer
-> writer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T compress writer -> T compress writer
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 = T Compressed writer -> writer
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 = T Uncompressed writer -> writer
forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
toWriter