slow vector stuff

slowvector.hs

module Main (main) where

import Sound.Wav
import Data.Int
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Builder
import Data.Monoid
import System.Environment
import System.Exit
import System.IO

import qualified Data.Vector as V
import Sound.Wav.ChannelData

{-
reverseData :: Int64 -> B.ByteString -> B.ByteString
reverseData c d = flipper . B.reverse $ d
  where flipperBuilder b
          | B.null b = mempty
          | otherwise =
            let (x, y) = B.splitAt c b
                x' = B.reverse x
            in lazyByteString x' <> flipperBuilder y
               
        flipper b = toLazyByteString (flipperBuilder b)
        
reverseWaveFile :: WaveFile -> Either String WaveFile
reverseWaveFile wf = Right wf'
  where wf' = wf { waveData = wd' }
        wd' = reverseData chans wd
        wd = waveData wf
        chans = fromIntegral . waveNumChannels . waveFormat $ wf
-}

reverseWaveFile :: WaveFile -> Either String WaveFile
reverseWaveFile wf = wf'
  where wf' = encodeIntegralWaveData wf `fmap` iwd' :: Either String WaveFile
        iwd' = IntegralWaveData `fmap` wd' :: Either String IntegralWaveData
        wd' = map V.reverse `fmap` wd :: Either String [IntegralWaveChannel {- = Vector Int64 -}]
        wd = (\(IntegralWaveData d) -> d) `fmap` iwd :: Either String [IntegralWaveChannel]
        iwd = extractIntegralWaveData wf :: Either String IntegralWaveData
          
main :: IO ()
main = do
  args <- getArgs
  case args of
    [fromFile, toFile] -> withWaveFile fromFile $ \ewf ->
      case ewf of
        Left err -> do
          hPutStrLn stderr "Parse error"
          hPutStrLn stderr err
          exitFailure
          
        Right wf ->
          case reverseWaveFile wf of
            Right rwf -> do
              encodeWaveFile toFile rwf
              hPutStrLn stderr ""
              hPutStrLn stderr "Done!"
              
            Left err -> do
              hPutStrLn stderr "Decode error"
              hPutStrLn stderr err
              exitFailure
          
    _ -> do
      hPutStrLn stderr "Usage: hrevoice <from> <to>"
      exitFailure