dump all midi to a database

this is too slow; there's a visible delay as the sql statement executes.

the plan is to run this in a separate thread

2 files changed, 33 insertions, 7 deletions

diff --git a/axis-of-eval.cabal b/axis-of-eval.cabal
index 4311a85..49ee7f7 100644
--- a/axis-of-eval.cabal
+++ b/axis-of-eval.cabal
@@ -26,6 +26,6 @@ executable midi-dump
   default-language: Haskell2010
   hs-source-dirs: .
   build-depends:
-    base, time, containers, haskore, alsa-seq, alsa-core, mtl, clock
+    base, time, containers, haskore, alsa-seq, alsa-core, mtl, clock, sqlite-simple, bytestring
   main-is: midi-dump.hs
   other-modules: AlsaSeq
diff --git a/midi-dump.hs b/midi-dump.hs
index 69f8480..a6fd36a 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+
 import AlsaSeq
 import Control.Concurrent (threadDelay)
 import qualified Sound.ALSA.Exception as AlsaExc
@@ -9,6 +12,13 @@ import Data.Maybe
 import Data.List
 import System.Clock
 
+import           Control.Applicative
+import qualified Data.ByteString as BS
+import           Database.SQLite.Simple
+import           Database.SQLite.Simple.FromRow
+import Data.Int
+import Data.ByteString.Char8 (pack)
+
 verbose = False
 
 main = main' `AlsaExc.catch` handler
@@ -31,7 +41,7 @@ data LoopState = LoopState {
 }
 
 getAbsTime = do
-  (startTime, startTimeReal, _, _, _, _, _, _) <- ask
+  (sqlite, startTime, startTimeReal, _, _, _, _, _, _) <- ask
   now <- liftIO $ getTime Monotonic
   return $ now - startTime + startTimeReal
 
@@ -45,11 +55,14 @@ main' = withAlsaInit $ \h public private q publicAddr privateAddr -> do
   startTime <- getTime Monotonic
   startTimeReal <- getTime Realtime
 
-  (_, ()) <- execRWST loop (startTime, startTimeReal, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime)
+  sqlite <- open "test.db"
+  execute_ sqlite "CREATE TABLE IF NOT EXISTS chunks (id INTEGER PRIMARY KEY, sec INTEGER, nsec INTEGER, midi BLOB)"
+
+  (_, ()) <- execRWST loop (sqlite, startTime, startTimeReal, h, public, private, q, publicAddr, privateAddr) (emptyLoopState startTime)
   return ()
 
 loop = do
-  (startTime, startTimeReal, h, _, _, q, publicAddr, _) <- ask
+  (_, startTime, startTimeReal, h, _, _, q, publicAddr, _) <- ask
 
   oldKeys <- gets keysDown
   let forwardNOW = forwardNoteEvent h q publicAddr
@@ -62,18 +75,31 @@ loop = do
     let newEvents = map (MidiEvent now) events
 
     liftIO $ printChordLn newKeys
-    modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s }
+    modify $ \s -> s { keysDown = newKeys, inputHistory = newEvents ++ inputHistory s, lastTick = now }
 
     when (Set.null newKeys) $ do
---    hist <- gets $ takeWhile (not . isSilence) . inputHistory
+      chunk <- gets $ takeWhile (not . isSilence) . inputHistory
+      saveMidi chunk
       hist <- gets $ filter (not . isSilence) . inputHistory
       liftIO $ print $ map (`div` 1000000) $ tsDeltas $ map getTS $ reverse hist
       liftIO $ print $ mapMaybe getMidiDesc $ reverse hist
       modify $ \s -> s { inputHistory = Silence now:inputHistory s }
 
-    modify $ \s -> s { lastTick = now }
   loop
 
+data Chunk = Chunk Int64 Int64 BS.ByteString
+instance FromRow Chunk where
+  fromRow = Chunk <$> field <*> field <*> field
+instance ToRow Chunk where
+  toRow (Chunk s ns b) = toRow (s, ns, b)
+
+saveMidi chunk = do
+  (sqlite, _, _, _, _, _, _, _, _) <- ask
+  (TimeSpec s ns) <- gets lastTick
+  let bytes = pack $ show chunk
+  liftIO $ execute sqlite "INSERT INTO chunks (sec, nsec, midi) VALUES (?,?,?)" (Chunk s ns bytes)
+  return ()
+
 getMidiDesc :: EVENT -> Maybe String
 getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOn  ev))) = return $ ("on:" ++)  $ showPitch $ unPitch $ Event.noteNote ev
 getMidiDesc (MidiEvent _ (Event.Cons _ _ _ _ _ _ (Event.NoteEv Event.NoteOff ev))) = return $ ("off:" ++) $ showPitch $ unPitch $ Event.noteNote ev