Command "save" now saves latest recording to disk

The filename is generated automatically from the date of the earliest
event in the recording.

1 files changed, 27 insertions, 6 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index 5285849..56a1d50 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -34,6 +34,10 @@ import qualified Codec.Midi
 import Codec.Midi (Midi(..), FileType(..), TimeDiv(..))
 
 import qualified Control.Concurrent.Thread as Thread
+import Data.Time.Format
+import Data.Time.LocalTime (utcToLocalZonedTime)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Data.Time.Clock (picosecondsToDiffTime, UTCTime)
 
 verbose :: Bool
 verbose = False
@@ -113,8 +117,8 @@ sqlInsert = fromString . concat $
   , "VALUES (?,?,?,?, ?,?,?,?, ?)"
   ]
 
-sqlSelectRECENT :: MidiController [CompleteRecording]
-sqlSelectRECENT = do
+_sqlSelectRECENT :: MidiController [CompleteRecording]
+_sqlSelectRECENT = do
   conn <- asks _sqlite
   fmap reverse $ liftIO $ query_ conn $ fromString . concat $
     [ "SELECT "
@@ -132,8 +136,8 @@ sqlSelectRECENT = do
     , " LIMIT 10"
     ]
 
-_sqlSelectEVERYTHING :: MidiController [CompleteRecording]
-_sqlSelectEVERYTHING = do
+sqlSelectEVERYTHING :: MidiController [CompleteRecording]
+sqlSelectEVERYTHING = do
   conn <- asks _sqlite
   liftIO $ query_ conn $ fromString . concat $
     [ "SELECT "
@@ -219,12 +223,25 @@ whenFlag flag f = asks flag >>= flip when f
 mkNote :: Word8 -> Event.Note
 mkNote pitch = Event.simpleNote (Event.Channel 0) (Event.Pitch pitch) (Event.Velocity 127)
 
+chooseFileName :: Recording -> MidiController FilePath
+chooseFileName r = do
+  let startTime = earliestEvent r
+  zonedTime <- liftIO $ utcToLocalZonedTime $ timeSpecAsUTCTime startTime
+  return $ formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q %Z%z.mid" zonedTime
+
+timeSpecAsUTCTime :: TimeSpec -> UTCTime
+timeSpecAsUTCTime = posixSecondsToUTCTime . fromRational . toRational . picosecondsToDiffTime . (* 1000) . timeSpecAsNanoSecs
+
 processCommand :: String -> MidiController ()
 processCommand "exit" = modify $ \s -> s { _wantExit = True }
 -- processCommand "" = return ()
 processCommand "" = gets _replay >>= playRecording
-processCommand "dump" = sqlSelectRECENT >>= playRecording . mconcat
-processCommand "save" = sqlSelectRECENT >>= saveRecording "saved.mid" . mconcat
+processCommand "save" = do
+  recording <- gets _replay
+  filename <- chooseFileName recording
+  saveRecording filename recording
+  liftIO $ putStrLn $ "Saved to " ++ filename
+processCommand "dump" = sqlSelectEVERYTHING >>= saveRecording "dumped.mid" . mconcat
 processCommand "C" = do
   let notes = (Event.NoteEv Event.NoteOn . mkNote) <$> [60, 64, 67]
   forM_ notes (delayNoteEv (TimeSpec 0 0))
@@ -382,6 +399,10 @@ detectTriads pitches = concatMap f (Map.keys pitches)
 sumM :: (Monad m, Num a, Foldable t) => t (m a) -> m a
 sumM = foldM (fmap . (+)) 0
 
+earliestEvent :: Recording -> TimeSpec
+earliestEvent (StartRecording x) = x
+earliestEvent (RecordingInProgress _ x _) = x
+
 latestEvent :: Recording -> TimeSpec
 latestEvent (StartRecording x) = x
 latestEvent (RecordingInProgress _ x []) = x