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 "" 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"