audacity-0.0: example/Concatenate.hs

module Main where

import qualified Sound.Audacity.LabelTrack as LabelTrack
import qualified Sound.SoxLib as SoxLib

import qualified Data.StorableVector.Lazy as SVL
import Foreign.Storable (peek, )

import Control.Monad (when, liftM2, )

import qualified Data.NonEmpty.Class as NonEmptyC
import qualified Data.NonEmpty as NonEmpty
import Data.Traversable (forM, )
import Data.NonEmpty ((!:), )
import Data.Maybe (fromMaybe, )

import qualified System.FilePath as FilePath
import qualified System.Exit as Exit
import qualified System.IO as IO
import System.Environment (getArgs, )
import System.FilePath ((<.>), )
import Text.Printf (printf, )

import Data.Int (Int32, )



exitFailureMsg :: String -> IO a
exitFailureMsg msg = do
   IO.hPutStrLn IO.stderr msg
   Exit.exitFailure


defaultSampleRate :: SoxLib.Rate
defaultSampleRate = 44100

withSound ::
   FilePath ->
   (SoxLib.Format SoxLib.ReadMode ->
    Maybe SoxLib.Rate -> Int -> SVL.Vector Int32 -> IO a) ->
   IO a
withSound path act =
   SoxLib.withRead SoxLib.defaultReaderInfo path $ \fmtPtr -> do
      fmt <- peek fmtPtr
      let sigInfo = SoxLib.signalInfo fmt
          numChan = fromMaybe 1 $ SoxLib.channels sigInfo
          rate = SoxLib.rate sigInfo
      act fmt rate numChan =<<
         SoxLib.readStorableVectorLazy fmtPtr
            (case SVL.defaultChunkSize of
               SVL.ChunkSize size -> SVL.ChunkSize $ numChan * size)


writerInfoFromFormat ::
   SoxLib.Format mode -> SoxLib.WriterInfo
writerInfoFromFormat fmtIn =
   SoxLib.defaultWriterInfo {
      SoxLib.writerSignalInfo = Just $ SoxLib.signalInfo fmtIn
   }


run :: NonEmpty.T [] FilePath -> FilePath -> IO ()
run neInputs@(NonEmpty.Cons input0 inputs) output = do
   let write fmtOut numChan sig = do
         SoxLib.writeStorableVectorLazy fmtOut sig
         return $! div (SVL.length sig) numChan
   (rate, lengths) <-
      withSound input0 $ \fmtIn rate0 numChan0 sig0 ->
      SoxLib.withWrite (writerInfoFromFormat fmtIn) output $ \fmtOut ->
      fmap ((,) rate0) $
      liftM2 NonEmpty.Cons
         (write fmtOut numChan0 sig0)
         (forM inputs $ \input ->
            withSound input $ \ _fmtIn rate numChan sig -> do
               let showRate = maybe "<no rate>" show
               when (rate0 /= rate) $
                  ioError $ userError $
                     printf "%s: rate %s differs from initial rate %s"
                        input (showRate rate) (showRate rate0)
               when (numChan0 /= numChan) $
                  ioError $ userError $
                     printf "%s: number channels (%d) differs from initial input (%d)"
                        input numChan numChan0
               write fmtOut numChan sig)
   LabelTrack.writeFileInt
         (fromMaybe defaultSampleRate rate)
         (FilePath.dropExtension output <.> "txt") $
      LabelTrack.fromAdjacentChunks $
      NonEmpty.flatten $ NonEmptyC.zip lengths $
      fmap FilePath.takeBaseName neInputs


main :: IO ()
main = do
   args <- getArgs

   case args of
      arg0 : arg1 : remArgs ->
         case NonEmpty.viewR $ arg0 !: arg1 !: remArgs of
            (inputs, output) -> SoxLib.formatWith $ run inputs output
      [_] -> exitFailureMsg "output file missing"
      [] -> exitFailureMsg "input and output files missing"