first python ana version

.gitignore

@@ -0,0 +1,7 @@
+.stack-work/
+*~
+*.aup
+*.swp
+*.wav
+*.lock
+*_data

CHANGELOG.md

@@ -0,0 +1,11 @@
+# Changelog for `autocut`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2022
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1 @@
+# autocut

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

analysis.py

@@ -0,0 +1,243 @@
+import librosa
+import librosa.display
+import numpy as np
+import matplotlib.pyplot as plt
+import soundfile as sf
+from pydub import AudioSegment
+from pydub.silence import split_on_silence, detect_nonsilent
+import math
+import wave
+import contextlib
+
+import webrtcvad
+
+
+def calc_dtw_sim(y1, y2, sr1, sr2, plot_result=False):
+    hop_length = 64
+
+    l = min(len(y1), len(y2))
+
+    to_consider = min(l, max(round(0.2*l), 2048))
+    bound = round(0.2 * l)
+
+    y1 = y1[0:round(0.2*l)]
+    y2 = y2[0:round(0.2*l)]
+
+    if bound < 2048:
+        n_fft = 512
+        n_mels = 64
+    else:
+        n_fft = 2048
+        n_mels = 128
+
+    mfcc1 = librosa.feature.mfcc(y=y1, sr=sr1, hop_length=hop_length, n_mfcc=42, n_fft=n_fft, n_mels=n_mels)[1:,:]
+    mfcc2 = librosa.feature.mfcc(y=y2, sr=sr2, hop_length=hop_length, n_mfcc=42, n_fft=n_fft, n_mels=n_mels)[1:,:]
+
+    D, wp = librosa.sequence.dtw(mfcc1, mfcc2)
+
+    if plot_result:
+        fig, ax = plt.subplots(nrows=4)
+
+        img = librosa.display.specshow(D, x_axis='frames', y_axis='frames',
+                                       ax=ax[0])
+
+        ax[0].set(title='DTW cost', xlabel='Noisy sequence', ylabel='Target')
+
+        ax[0].plot(wp[:, 1], wp[:, 0], label='Optimal path', color='y')
+
+        ax[0].legend()
+
+        fig.colorbar(img, ax=ax[0])
+
+        ax[1].plot(D[-1, :] / wp.shape[0])
+
+        ax[1].set(xlim=[0, mfcc1.shape[1]],
+                  title='Matching cost function')
+
+        ax[2].imshow(mfcc1)
+        ax[3].imshow(mfcc2)
+
+        plt.show()
+    total_alignment_cost = D[-1, -1] / wp.shape[0]
+
+    return total_alignment_cost
+
+
+def calc_xcorr_sim(y1, y2, sr1, sr2):
+    hop_length = 256
+
+    y1 = y1[0:round(len(y1)*0.2)]
+    y2 = y2[0:round(len(y2)*0.2)]
+
+    mfcc1 = librosa.feature.mfcc(y=y1, sr=sr1, hop_length=hop_length, n_mfcc=13)[1:,:]
+    mfcc2 = librosa.feature.mfcc(y=y2, sr=sr2, hop_length=hop_length, n_mfcc=13)[1:,:]
+
+    xsim = librosa.segment.cross_similarity(mfcc1, mfcc2, mode='distance')
+    return xsim
+
+
+def match_target_amplitude(aChunk, target_dBFS):
+    ''' Normalize given audio chunk '''
+    change_in_dBFS = target_dBFS - aChunk.dBFS
+    return aChunk.apply_gain(change_in_dBFS)
+
+
+def spl_on_silence():
+    # Import the AudioSegment class for processing audio and the 
+
+    # Load your audio.
+    song = AudioSegment.from_wav("recording.wav")
+
+    # Split track where the silence is 2 seconds or more and get chunks using 
+    # the imported function.
+    chunks = split_on_silence (
+        # Use the loaded audio.
+        song, 
+        # Specify that a silent chunk must be at least 2 seconds or 2000 ms long.
+        min_silence_len = 1000,
+        # Consider a chunk silent if it's quieter than -16 dBFS.
+        # (You may want to adjust this parameter.)
+        silence_thresh = -50,
+        timestamps=True
+    )
+
+    ## Process each chunk with your parameters
+    #for i, chunk in enumerate(chunks):
+    #    # Create a silence chunk that's 0.5 seconds (or 500 ms) long for padding.
+    #    silence_chunk = AudioSegment.silent(duration=500)
+
+    #    # Add the padding chunk to beginning and end of the entire chunk.
+    #    audio_chunk = silence_chunk + chunk + silence_chunk
+
+    #    # Normalize the entire chunk.
+    #    normalized_chunk = match_target_amplitude(audio_chunk, -20.0)
+
+    #    # Export the audio chunk with new bitrate.
+    #    print("Exporting chunk{0}.mp3.".format(i))
+    #    normalized_chunk.export(
+    #        ".//chunk{0}.wav".format(i),
+    #        bitrate = "192k",
+    #        format = "wav"
+    #    )
+    return ([ audiosegment_to_librosawav(c) for c in chunks ], song.frame_rate)
+
+
+def non_silent_chunks(song):
+    #song = AudioSegment.from_wav("recording.wav")
+
+    return detect_nonsilent(song, min_silence_len=400, silence_thresh=-50)
+
+
+def audiosegment_to_librosawav(audiosegment):    
+    channel_sounds = audiosegment.split_to_mono()
+    samples = [s.get_array_of_samples() for s in channel_sounds]
+
+    fp_arr = np.array(samples).T.astype(np.float32)
+    fp_arr /= np.iinfo(samples[0].typecode).max
+    fp_arr = fp_arr.reshape(-1)
+
+    return fp_arr
+
+
+# sr = samples / second
+def millisecond_to_samples(ms, sr):
+    return round((ms / 1000) * sr)
+
+
+def ms_to_time(ms):
+    secs = ms / 1000
+    return "{0}:{1}".format(math.floor(secs / 60), secs % 60)
+
+
+def seg_is_speech(seg):
+    f = lambda x: int(32768 * x)
+    x = np.vectorize(f)(seg)
+    pcm_data = x.tobytes()
+
+    speeches = 0
+    total = 0
+    offset = 0
+    n = int(sr * (frame_duration_ms / 1000.0) * 2)
+    duration = (float(n) / sr) / 2.0
+
+    while offset + n < len(pcm_data):
+        frame = pcm_data[offset:(offset+n)]
+        if vad.is_speech(frame, sr):
+            speeches += 1
+        offset = offset + n
+        total += 1
+
+    return speeches / total
+
+if __name__ == '__main__':
+    vad = webrtcvad.Vad()
+
+    frame_duration_ms = 10
+    fp = "hard_piece_2.wav"
+    y, sr = librosa.load(fp, mono=True, sr=32000)
+
+    #pcm_data = y.tobytes()
+
+    #n = int(sample_rate * (frame_duration_ms / 1000.0) * 2)
+    #duration = (float(n) / sample_rate) / 2.0
+    #frame = pcm_data[0:n]
+
+    #y, sr = librosa.load("recording.wav")
+    song = AudioSegment.from_wav(fp)
+    #print("pydub load done")
+
+    #with contextlib.closing(wave.open(fp, "rb")) as wf:
+    #    num_channels = wf.getnchannels()
+    #    assert num_channels == 1
+    #    sample_width = wf.getsampwidth()
+    #    assert sample_width == 2
+    #    sample_rate = wf.getframerate()
+    #    assert sample_rate in (8000, 16000, 32000, 48000)
+    #    pcm_data = wf.readframes(wf.getnframes())
+
+    #    n = int(sample_rate * (frame_duration_ms / 1000.0) * 2)
+    #    duration = (float(n) / sample_rate) / 2.0
+    #    frame = pcm_data[0:n]
+
+    #    #print(len(pcm_data))
+    #    print(vad.is_speech(frame, sample_rate))
+
+    #y2 = audiosegment_to_librosawav(song)
+    #print(y)
+    #print(y2)
+
+    #segs = librosa.effects.split(y, top_db = 5, hop_length=512, frame_length=4096)
+
+    #segs, sr = spl_on_silence()
+
+    #print("librosa load done")
+
+    segs = []
+    for ts in non_silent_chunks(song):
+        start, end = ts[0], ts[1]
+        seg = y[ millisecond_to_samples(start, sr) : millisecond_to_samples(end, sr) ]
+        segs.append(((start, end), seg))
+
+    for i in range(len(segs)-1):
+        (s1, e1), y1 = segs[i]
+        (s2, e2), y2 = segs[i+1]
+        diff = calc_dtw_sim(y1, y2, sr, sr, plot_result=False)
+        vad_coeff = seg_is_speech(y1)
+
+        #if diff < 100:
+        #print("{0}\t{1}\tdiff: {2}, vad: {3}".format(s1/1000, e1/1000, diff, vad_coeff))
+            #print(ms_to_time(s1), ms_to_time(e1), ms_to_time(s2), ms_to_time(e2), diff)
+
+        #if vad_coeff < 0.9:
+        #print("{0}\t{1}\tvad {2}".format(s1/1000, e1/1000, vad_coeff))
+
+
+    #for n, seg in enumerate(segs):
+    #    sf.write('part' + str(n) + '.wav', seg, sr)
+    #print(segs)
+
+    #y1, sr1 = librosa.load("out000.wav")
+    #y2, sr2 = librosa.load("out004.wav")
+
+    #print("total alignment cost:", calc_dtw_sim(y1, y2, sr1, sr2, plot_result=True))
+    #print("xcorr:", np.trace(calc_xcorr_sim(y1, y2, sr1, sr2)))

app/Main.hs

@@ -0,0 +1,97 @@
+module Main (main) where
+
+import Lib
+import Parser
+import Driver
+import Types
+
+runDehum :: Flags -> FilePath -> FilePath -> IO ()
+runDehum flags input output =
+   withSound flags input $ \fmtIn params sig ->
+   SoxLib.withWrite
+      (writerInfoFromFormat fmtIn params)
+      output $ \fmtOut ->
+         SoxLib.writeStorableVectorLazy fmtOut $
+         SVL.interleaveFirstPattern $
+         map
+            (Causal.apply
+               (arr (Bin.fromCanonicalWith Real.roundSimple)
+                <<<
+                dehum params
+                <<<
+                arr Bin.toCanonical)) $
+         SVL.deinterleave (numChannels params) sig
+
+runEnvelope :: Flags -> FilePath -> FilePath -> IO ()
+runEnvelope flags input output =
+   withSound flags input $ \fmtIn params sig ->
+   SoxLib.withWrite
+      (monoInfoFromFormat fmtIn params)
+      output $ \fmtOut ->
+         SoxLib.writeStorableVectorLazy fmtOut $
+         Causal.apply
+            (arr (Bin.fromCanonicalWith Real.roundSimple)) $
+         trackEnvelope params $
+         map
+            (Causal.apply
+               (arr (^2)
+                <<<
+                dehum params
+                <<<
+                arr Bin.toCanonical)) $
+         SVL.deinterleave (numChannels params) sig
+
+runSizes :: Flags -> FilePath -> IO ()
+runSizes flags input =
+   withSound flags input $ \_fmt params sig ->
+   mapM_ print $ pieceDurations params sig
+
+runLabels :: Flags -> FilePath -> IO ()
+runLabels flags input =
+   withSound flags input $ \_fmt params sig ->
+   mapM_ (\(n, (from,to)) -> printf "%s\t%s\t%d\n" from to n) $
+   zip [(0::Int) ..] $
+   ListHT.mapAdjacent (,) $
+   map (\t ->
+      case divMod (Real.roundSimple (fromIntegral t * 10^6 / sampleRate params)) (10^6) of
+         -- FIXME: the comma is certainly only correct in German locale
+         (seconds,micros) ->
+            printf "%d,%06d" seconds (micros::Integer) :: String) $
+   scanl (+) 0 $
+   prefetch (preStart params) $
+   pieceDurations params sig
+
+{- |
+> runChop flags "in.wav" "%03d.wav"
+-}
+runChop :: Flags -> FilePath -> FilePath -> IO ()
+runChop flags input output =
+   withSound flags input $ \fmtIn params sig ->
+   forM_ (zip [(0::Int)..] $ chopLazy params sig) $ \(n,piece) ->
+      SoxLib.withWrite
+         (writerInfoFromFormat fmtIn params)
+         (printf output n) $ \fmtOut ->
+            SoxLib.writeStorableVectorLazy fmtOut piece
+
+main :: IO ()
+main = SoxLib.formatWith $ do
+   argv <- getArgs
+   let (opts, files, errors) =
+          getOpt Opt.RequireOrder description argv
+   when (not $ null errors) $
+      exitFailureMsg (init (concat errors))
+
+   flags <- foldl (>>=) (return defltFlags) opts
+
+   if flagComputeEnvelope flags
+     then
+       case files of
+          [input,output] -> runEnvelope flags input output
+          [] -> exitFailureMsg "need input and output file envelope computation"
+          _ -> exitFailureMsg "more than two file names given"
+     else
+       case files of
+          [input,output] -> runChop flags input output
+          [input] -> runLabels flags input
+          [] -> exitFailureMsg "no input or output given"
+          _ -> exitFailureMsg "more than two file names given"

autocut.cabal

@@ -0,0 +1,85 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.4.
+--
+-- see: https://github.com/sol/hpack
+
+name:           autocut
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/autocut#readme>
+homepage:       https://github.com/githubuser/autocut#readme
+bug-reports:    https://github.com/githubuser/autocut/issues
+author:         Author name here
+maintainer:     example@example.com
+copyright:      2022 Author name here
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/githubuser/autocut
+
+library
+  exposed-modules:
+      Driver
+      Lib
+      Parser
+      Types
+  other-modules:
+      Paths_autocut
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      base >=4.7 && <5
+    , numeric-prelude
+    , shell-utility
+    , soxlib
+    , storablevector
+    , synthesizer-core
+    , transformers
+    , utility-ht
+  default-language: Haskell2010
+
+executable autocut-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_autocut
+  hs-source-dirs:
+      app
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      autocut
+    , base >=4.7 && <5
+    , numeric-prelude
+    , shell-utility
+    , soxlib
+    , storablevector
+    , synthesizer-core
+    , transformers
+    , utility-ht
+  default-language: Haskell2010
+
+test-suite autocut-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_autocut
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      autocut
+    , base >=4.7 && <5
+    , numeric-prelude
+    , shell-utility
+    , soxlib
+    , storablevector
+    , synthesizer-core
+    , transformers
+    , utility-ht
+  default-language: Haskell2010

package.yaml

@@ -0,0 +1,66 @@
+name:                autocut
+version:             0.1.0.0
+github:              "githubuser/autocut"
+license:             BSD3
+author:              "Author name here"
+maintainer:          "example@example.com"
+copyright:           "2022 Author name here"
+
+extra-source-files:
+- README.md
+- CHANGELOG.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/githubuser/autocut#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- transformers
+- synthesizer-core
+- soxlib
+- numeric-prelude
+- utility-ht
+- storablevector
+- shell-utility
+
+ghc-options:
+- -Wall
+- -Wcompat
+- -Widentities
+- -Wincomplete-record-updates
+- -Wincomplete-uni-patterns
+- -Wmissing-export-lists
+- -Wmissing-home-modules
+- -Wpartial-fields
+- -Wredundant-constraints
+
+library:
+  source-dirs: src
+
+executables:
+  autocut-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - autocut
+
+tests:
+  autocut-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - autocut

src/Driver.hs

@@ -0,0 +1,59 @@
+module Driver where
+
+import qualified Sound.SoxLib as SoxLib
+import Types
+
+withSound ::
+   Flags -> FilePath ->
+   (SoxLib.Format SoxLib.ReadMode ->
+    Params -> SVL.Vector Int32 -> IO b) ->
+   IO b
+withSound flags path act =
+   SoxLib.withRead SoxLib.defaultReaderInfo path $ \fmtPtr -> do
+      fmt <- peek fmtPtr
+      let numChan =
+             fromMaybe 1 $ SoxLib.channels $ SoxLib.signalInfo fmt
+          rate =
+             case flagSampleRate flags of
+                Just r -> r
+                Nothing ->
+                   case SoxLib.rate $ SoxLib.signalInfo fmt of
+                      Just r -> r
+                      Nothing -> defaultSampleRate
+          params =
+             Params {
+                sampleRate = rate,
+                numChannels = numChan,
+                smooth = freq rate flagSmooth flags,
+                humFreq = freq rate flagHumFreq flags,
+                pauseVolume = flagPauseVolume flags,
+                minPause = time rate flagMinPause flags,
+                preStart = time rate flagPreStart flags
+             }
+      act fmt params =<<
+         SoxLib.readStorableVectorLazy fmtPtr
+            (case flagBlocksize flags of
+               SVL.ChunkSize size -> SVL.ChunkSize $ numChan * size)
+
+monoInfoFromFormat ::
+   SoxLib.Format mode -> Params -> SoxLib.WriterInfo
+monoInfoFromFormat fmtIn params =
+   SoxLib.defaultWriterInfo {
+      SoxLib.writerSignalInfo = Just $
+         (SoxLib.signalInfo fmtIn) {
+            SoxLib.channels = Just 1,
+            SoxLib.rate = Just $ sampleRate params
+         },
+      SoxLib.writerEncodingInfo = Just $ SoxLib.encodingInfo fmtIn
+   }
+
+writerInfoFromFormat ::
+   SoxLib.Format mode -> Params -> SoxLib.WriterInfo
+writerInfoFromFormat fmtIn params =
+   SoxLib.defaultWriterInfo {
+      SoxLib.writerSignalInfo = Just $
+         (SoxLib.signalInfo fmtIn) {
+            SoxLib.rate = Just $ sampleRate params
+         },
+      SoxLib.writerEncodingInfo = Just $ SoxLib.encodingInfo fmtIn
+   }

src/Lib.hs

@@ -0,0 +1,129 @@
+module Lib (someFunc) where
+
+import qualified Synthesizer.Storable.Signal as SigSt
+import qualified Synthesizer.ChunkySize.Cut as CutCS
+import qualified Synthesizer.ChunkySize as ChunkySize
+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
+import qualified Synthesizer.Causal.Process as Causal
+import qualified Synthesizer.State.Cut as Cut
+import qualified Synthesizer.State.Signal as Sig
+import qualified Synthesizer.Basic.Binary as Bin
+
+import qualified Sound.SoxLib as SoxLib
+
+import qualified Data.StorableVector.Lazy as SVL
+import Foreign.Storable (peek, )
+
+import qualified Control.Monad.Trans.State as MS
+import Control.Monad (when, )
+import Control.Arrow (arr, (<<<), (^<<), )
+
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Tuple.HT (swap, )
+import Data.Foldable (forM_, )
+import Data.Maybe (fromMaybe, )
+
+import qualified System.Console.GetOpt as Opt
+import System.Console.GetOpt
+          (getOpt, usageInfo, ArgDescr(NoArg, ReqArg), )
+import System.Environment (getArgs, getProgName, )
+import Text.Printf (printf, )
+
+import qualified System.Exit as Exit
+import Shell.Utility.Exit (exitFailureMsg)
+
+import qualified Algebra.RealRing as Real
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+import Data.Int (Int32, )
+
+import Types
+import Driver
+
+import Prelude ()
+
+dehum :: Params -> Causal.T Float Float
+dehum params =
+   Filt1.highpass_
+   ^<<
+   Filt1.causal
+   <<<
+   Causal.feedConstFst (Filt1.parameter (humFreq params))
+
+trackEnvelope :: Params -> [SVL.Vector Float] -> SVL.Vector Float
+trackEnvelope params =
+   Causal.apply
+      (Filt1.lowpassCausal
+       <<<
+       Causal.feedConstFst (Filt1.parameter (smooth params))
+       <<<
+       arr sqrt)
+   .
+   foldl SigSt.mix SVL.empty
+
+threshold :: Params -> Causal.T Float Bool
+threshold params = Causal.map (< pauseVolume params)
+
+findStarts :: Params -> Causal.T Bool Bool
+findStarts params =
+   flip Causal.fromState 0 $ \b ->
+      if b
+        then MS.modify succ >> evalReturn False
+        else do n <- MS.get; MS.put 0; return (n >= minPause params)
+
+measurePauses :: Causal.T Bool (Maybe Int)
+measurePauses =
+   flip Causal.fromState 0 $ \b ->
+      if b
+        then do n <- MS.get; MS.put 1; return (Just n)
+        else MS.modify succ >> evalReturn Nothing
+
+evalReturn :: a -> MS.State Int a
+evalReturn x =
+   MS.gets (\n -> seq n x)
+
+pieceDurations :: Params -> SVL.Vector Int32 -> [Int]
+pieceDurations params =
+--   catMaybes . Sig.toList .
+   Sig.foldR (maybe id (:)) [] .
+   Causal.apply
+      (measurePauses <<< findStarts params <<< threshold params) .
+   Sig.fromStorableSignal .
+   trackEnvelope params .
+   map (Causal.apply (arr (^2) <<< dehum params <<< arr Bin.toCanonical)) .
+   SVL.deinterleave (numChannels params)
+
+pieceDurationsPrefetchLazy :: Params -> SVL.Vector Int32 -> [ChunkySize.T]
+pieceDurationsPrefetchLazy params sig =
+   flip Cut.chopChunkySize (CutCS.length sig) .
+   flip Sig.append (Sig.repeat False) .
+   Sig.drop (preStart params) .
+   Causal.apply (findStarts params <<< threshold params) .
+   Sig.fromStorableSignal .
+   trackEnvelope params .
+   map (Causal.apply (arr (^2) <<< dehum params <<< arr Bin.toCanonical)) .
+   SVL.deinterleave (numChannels params) $ sig
+
+
+prefetch :: Int -> [Int] -> [Int]
+prefetch _ [] = []
+prefetch n (s:ss) =
+   if s <= n
+     then prefetch (n-s) ss
+     else (s-n) : ss
+
+chop, chopLazy ::
+   Params -> SVL.Vector Int32 -> [SVL.Vector Int32]
+chop params sig0 =
+   snd $
+   List.mapAccumL (\sig n -> swap $ SVL.splitAt n sig) sig0 $
+   map (numChannels params *) .
+   prefetch (preStart params) $ pieceDurations params sig0
+
+chopLazy params sig0 =
+   snd $
+   List.mapAccumL (\sig n -> swap $ CutCS.splitAt n sig) sig0 $
+   map (fromIntegral (numChannels params) *) .
+   pieceDurationsPrefetchLazy params $ sig0

src/Parser.hs

@@ -0,0 +1,87 @@
+module Parser where
+
+import qualified Sound.SoxLib as SoxLib
+
+import Types
+import Driver
+
+parseCard :: (Read a, Real.C a) => String -> String -> IO a
+parseCard name str =
+   case reads str of
+      [(n,"")] ->
+         case compare n zero of
+           GT -> return n
+           EQ -> exitFailureMsg $ name ++ " must not be zero"
+           LT -> exitFailureMsg $ "negative " ++ name ++ ": " ++ str
+      _ -> exitFailureMsg $ "could not parse " ++ name ++ " " ++ show str
+
+numberArg ::
+   (Read a, Real.C a) =>
+   String -> (a -> Flags -> IO Flags) ->
+   Opt.ArgDescr (Flags -> IO Flags)
+numberArg name update =
+   flip ReqArg name $ \str flags ->
+      flip update flags =<< parseCard name str
+
+description :: [ Opt.OptDescr (Flags -> IO Flags) ]
+description =
+    Opt.Option ['h'] ["help"]
+        (NoArg $ \ _flags -> do
+           programName <- getProgName
+           putStrLn $
+              usageInfo ("Usage: " ++ programName ++ " [OPTIONS] INPUT [OUTPUT]") $
+              description
+           Exit.exitSuccess)
+        "show options" :
+    Opt.Option ['r'] ["rate"]
+        (numberArg "SAMPLERATE" $ \n flags ->
+           return $ flags{flagSampleRate = Just n})
+        ("sample rate, default " ++ show defaultSampleRate) :
+    Opt.Option [] ["pause-volume"]
+        (numberArg "AMPLITUDE" $ \n flags ->
+           return $ flags{flagPauseVolume = n})
+        ("required maximum amplitude in pauses between pieces, default " ++ show (flagPauseVolume defltFlags)) :
+    Opt.Option [] ["smooth"]
+        (numberArg "FREQUENCY" $ \n flags ->
+           return $ flags{flagSmooth = Freq n})
+        ("cutoff frequency for smoothing envelope, default " ++ formatFreq (flagSmooth defltFlags)) :
+    Opt.Option [] ["hum-frequency"]
+        (numberArg "FREQUENCY" $ \n flags ->
+           return $ flags{flagHumFreq = Freq n})
+        ("cutoff frequency for hum elimination, default " ++ formatFreq (flagHumFreq defltFlags)) :
+    Opt.Option [] ["min-pause"]
+        (numberArg "TIME" $ \n flags ->
+           return $ flags{flagMinPause = Time n})
+        ("minimal required pause between pieces, default " ++ formatTime (flagMinPause defltFlags)) :
+    Opt.Option [] ["pre-start"]
+        (numberArg "TIME" $ \n flags ->
+           return $ flags{flagPreStart = Time n})
+        ("time to start before threshold is exceeded, default " ++ formatTime (flagPreStart defltFlags)) :
+    Opt.Option [] ["blocksize"]
+        (numberArg "NUMSAMPLES" $ \n flags ->
+           return $ flags{flagBlocksize = SVL.chunkSize n})
+        ("size of processing chunks, default " ++
+         case flagBlocksize defltFlags of SVL.ChunkSize size -> show size) :
+    Opt.Option [] ["compute-envelope"]
+        (NoArg $ \ flags -> do
+           return $ flags{flagComputeEnvelope = True})
+        "compute envelope for assistance in finding appropriate parameters" :
+    []
+
+defaultSampleRate :: SoxLib.Rate
+defaultSampleRate = 44100
+
+freq :: SoxLib.Rate -> (Flags -> Freq) -> (Flags -> Float)
+freq sr acc flags =
+   (case acc flags of Freq f -> f) / realToFrac sr
+
+time :: SoxLib.Rate -> (Flags -> Time) -> (Flags -> Int)
+time sr acc flags =
+   round ((case acc flags of Time t -> t) * realToFrac sr)
+
+formatFreq :: Freq -> String
+formatFreq (Freq t) = show t -- ++ "Hz"
+
+formatTime :: Time -> String
+formatTime (Time t) = show t -- ++ "s"
+

src/Types.hs

@@ -0,0 +1,45 @@
+module Types where
+
+newtype Time = Time Float
+   deriving (Eq, Show)
+
+newtype Freq = Freq Float
+   deriving (Eq, Show)
+
+data Flags =
+   Flags {
+      flagComputeEnvelope :: Bool,
+      flagSampleRate :: Maybe SoxLib.Rate,
+      flagSmooth, flagHumFreq :: Freq,
+      flagPauseVolume :: Float,
+      flagMinPause, flagPreStart :: Time,
+      flagBlocksize :: SVL.ChunkSize
+   }
+
+defltFlags :: Flags
+defltFlags =
+   Flags {
+      flagComputeEnvelope = False,
+      flagSampleRate = Nothing,
+      flagSmooth = Freq 1,
+      flagHumFreq = Freq 100,
+      flagPauseVolume = 0.02,
+      flagMinPause = Time 2,
+      {-
+      Sometimes a piece starts with breath which is almost undetectable.
+      Thus we start a little bit earlier than necessary.
+      -}
+      -- flagPreStart = Time 1.5,
+      flagPreStart = Time 0.05,
+      flagBlocksize = SVL.chunkSize 65536
+   }
+
+
+data Params =
+   Params {
+      sampleRate :: SoxLib.Rate,
+      numChannels :: Int,
+      smooth, humFreq :: Float,
+      pauseVolume :: Float,
+      minPause, preStart :: Int
+   }

stack.yaml

@@ -0,0 +1,67 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver:
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/21.yaml
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"