Deserialization with Sound.MIDI.Message

This format is still inefficient -- because the time is still
represented as a string that is parsed as an Integer -- but it's
certainly much more efficient than before. And more importantly, it can
be both written and read.

1 files changed, 22 insertions, 3 deletions

diff --git a/Midi.hs b/Midi.hs
index 64226f3..e335cd4 100644
--- a/Midi.hs
+++ b/Midi.hs
@@ -2,7 +2,8 @@
 module Midi where
 import           BasePrelude
 import qualified Data.ByteString as BS
-import           Data.ByteString.Char8 (pack)
+import qualified Data.ByteString.Lazy as LBS
+import           Data.ByteString.Char8 (pack, unpack)
 import           Prelude               hiding (id, (.))
 -- import           Sound.MIDI.ALSA
 import           System.Clock
@@ -17,6 +18,7 @@ import Sound.MIDI.Message
 
 import Codec.Midi
 import Codec.ByteString.Builder
+import Codec.ByteString.Parser
 
 -- import qualified Sound.ALSA.Sequencer
 -- import qualified Sound.ALSA.Sequencer.Address
@@ -97,6 +99,23 @@ stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecord
 stopRecording _ _ = Nothing
 
 midiToBytes :: [RecordedEvent] -> BS.ByteString
-midiToBytes = pack . show . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage)
+midiToBytes = pack . show . overFirsts toDeltas . map (first timeSpecAsNanoSecs) . (fmap . fmap) (toLazyByteString . buildMessage) . reverse
 bytesToMidi :: BS.ByteString -> [RecordedEvent]
-bytesToMidi = undefined
+bytesToMidi = unpack >>> read >>> overFirsts fromDeltas >>> map (first fromInteger) >>> (fmap . fmap) f >>> reverse
+  where f :: LBS.ByteString -> Codec.Midi.Message
+        f = runParser (parseMessage Nothing) >>> either error id
+
+overFirsts :: ([a1] -> [a]) -> [(a1, b)] -> [(a, b)]
+overFirsts f = uncurry zip . first f . unzip
+
+toDeltas :: Num n => [n] -> [n]
+toDeltas xs = zipWith (-) xs (0:xs)
+
+fromDeltas :: Num n => [n] -> [n]
+fromDeltas = helper 0
+    where
+      helper _ [] = []
+      helper n (x:xs) = (n+x) : helper (n+x) xs
+
+-- fromDeltas :: Num n => [n] -> [n]
+-- fromDeltas = foldr (\a b -> a:map (a +) b) []