Export metronome click track

Main.hs

@@ -97,6 +97,13 @@ main = do
             in do
               putStrLn "Exporting backing audio (could take a while)"
               runAudio [fback] others fout
+        case matches of
+          [] -> return ()
+          (fp, _, _) : _ -> loadBeats fp >>= \mb -> case mb of
+            Nothing -> return ()
+            Just beats -> do
+              putStrLn "Exporting metronome click track"
+              writeMetronomeTrack (dout </> "click.wav") beats
   case function args of
     PrintUsage -> printUsage
     ShowDatabase -> do
@@ -109,6 +116,17 @@ main = do
         (Left  err   , _           ) -> error err
         (_           , Left  err   ) -> error err
         (Right yaifcs, Right naifcs) -> runAudio yaifcs naifcs fout
+    ExportClick fout -> do
+      matches <- searchResultsChecked args
+      case matches of
+        [] -> do
+          putStrLn "No songs matched your search."
+          exitFailure
+        (fp, _, _) : _ -> loadBeats fp >>= \mb -> case mb of
+          Nothing -> do
+            putStrLn $ "Couldn't load beats.plist from the folder: " ++ fp
+            exitFailure
+          Just beats -> writeMetronomeTrack fout beats
     CheckPresence -> do
       matches <- getAudioParts <$> searchResultsChecked args
       let f = mapM (`getOneResult` matches) . mapMaybe charToAudioPart
@@ -247,6 +265,9 @@ argOpts =
   , Opt.Option ['a'] ["audio"]
     (Opt.ReqArg (\s a -> a { function = ExportAudio s }) "file")
     "function: export audio"
+  , Opt.Option ['m'] ["metronome"]
+    (Opt.ReqArg (\s a -> a { function = ExportClick s }) "file")
+    "function: export metronome audio"
   , Opt.Option ['x'] ["export"]
     (Opt.ReqArg (\s a -> a { function = ExportAll s }) "dir")
     "function: export song to dir"
@@ -272,6 +293,7 @@ data Function
   | ShowDatabase
   | ExportSheet FilePath
   | ExportAudio FilePath
+  | ExportClick FilePath
   | ExportAll   FilePath
   | ExportLib   FilePath
   | CheckPresence

src/Sound/Jammit/Export.hs

@@ -11,10 +11,12 @@ module Sound.Jammit.Export
 , audioSource
 , runAudio
 , runSheet
+, metronomeTrack
+, writeMetronomeTrack
 ) where
 
 import Control.Applicative (liftA2)
-import Control.Monad (forM)
+import Control.Monad (forM, forever)
 import Data.Char (toLower)
 import Data.Int (Int16, Int32)
 import Data.List (isInfixOf, sort, isPrefixOf)
@@ -125,3 +127,22 @@ runSheet trks lns fout = runTempIO fout $ do
   pdf <- newTempFile "pages.pdf"
   liftIO $ jpegsToPDF jpegs pdf
   return pdf
+
+writeMetronomeTrack :: FilePath -> [Beat] -> IO ()
+writeMetronomeTrack fp beats = runResourceT $ writeWAV fp $ metronomeTrack beats
+
+metronomeTrack :: (Monad m) => [Beat] -> A.AudioSource m Int16
+metronomeTrack beats = let
+  samples = map (\b -> floor $ position b * 44100) beats
+  clicks = zipWith makeClick samples $ map Just (drop 1 samples) ++ repeat Nothing
+  makeClick f1 (Just f2) = A.takeStart (A.Frames $ f2 - f1) $ A.concatenate metronomeClick infiniteSilence
+  makeClick _  Nothing   = metronomeClick
+  silentBlock = A.silent (A.Frames A.chunkSize) 44100 2
+  zeroAudio = A.silent (A.Frames 0) 44100 2
+  infiniteSilence = A.AudioSource
+    { A.rate = 44100
+    , A.channels = 2
+    , A.frames = 0
+    , A.source = forever $ A.source silentBlock
+    }
+  in foldr A.concatenate zeroAudio clicks

stack.yaml

@@ -3,4 +3,4 @@ packages:
 - '.'
 extra-deps:
 - conduit-audio-0.2.0.2
-resolver: nightly-2016-07-04
+resolver: lts-7.6