lambdasound 1.0.1 → 1.1

raw patch · 15 files changed

+351/−140 lines, 15 filesdep −binarydep ~basenew-component:exe:example3PVP ok

version bump matches the API change (PVP)

Dependencies removed: binary

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +2/−0
• bench/Main.hs +16/−1
• example/Example1.hs +0/−59
• example/Example2.hs +1/−2
• example/Example3.hs +7/−0
• lambdasound.cabal +15/−3
• src/LambdaSound.hs +4/−0
• src/LambdaSound/Cache.hs +31/−25
• src/LambdaSound/Sampling.hs +28/−26
• src/LambdaSound/SaveAndLoad.hs +61/−0
• src/LambdaSound/SaveAndLoad/RawSamples.hs +103/−0
• src/LambdaSound/Sound.hs +17/−0
• src/LambdaSound/Sound/ComputeSound.hs +58/−23
• src/LambdaSound/Sound/Types.hs +1/−1

@@ -1,5 +1,12 @@ # Revision history for lambdasound +## 1.1.0 -- 2023-10-16++* Add an example to showcase `loadSound`+* Support loading of wav and raw files as `Sound`+* Fix pathological behavior for repeated cached sounds+* Add `embedIO` to embed IO into sound generation+ ## 1.0.1 -- 2023-10-13  * Add `withSampledSound` and `withSampledSoundPulse`

@@ -74,6 +74,8 @@ - Cut apart sounds with `takeSound` and `dropSound` - Scaling playing speed - Cache expensive to compute sounds in your XDG-cache directory+- Loading wav files (with some caveats)+- Embed IO into sounds  ## Building 

@@ -20,17 +20,23 @@           bench "Dropped sound" $ nfSound droppedSound,           bench "Taken sound" $ nfSound takenSound,           bench "Cached sound" $ nfSound cachedSound,+          bench "Repeated cached sound" $ nfSound repeatedCachedSound,           bench "Timed parallel sound" $ nfSound timedParallelSound,           bench "Unfold pulse" $ nfSound unfoldPulse,           bench "Unfold normally" $ nfSound unfoldNormally,           bench "With sampled sound" $ nfSound useSampledSound,-          bench "Repeated with sampled sound" $ nfSound repeatedSampledSound+          bench "Repeated with sampled sound" $ nfSound repeatedSampledSound,+          bench "Load sound" $ nfSound loadedSound,+          bench "Repeated with loaded sound" $ nfSound repeatedLoadedSound         ]     ]  nfSound :: Sound T Pulse -> Benchmarkable nfSound = nfIO . sampleSound 44100 +nfSoundIO :: IO (Sound T Pulse) -> Benchmarkable+nfSoundIO sound = nfIO $ sound >>= sampleSound 44100+ simplePulse :: Sound T Pulse simplePulse = 3 |-> sineWave 440 @@ -74,6 +80,9 @@ cachedSound :: Sound T Pulse cachedSound = cache longSound +repeatedCachedSound :: Sound T Pulse+repeatedCachedSound = repeatSound 20 cachedSound+ timedParallelSound :: Sound T Pulse timedParallelSound =   parallel $@@ -100,3 +109,9 @@  repeatedSampledSound :: Sound T Pulse repeatedSampledSound = repeatSound 20 useSampledSound++loadedSound :: Sound T Pulse+loadedSound = setDuration 3 $ embedIOLazily $ loadWav "sample-sounds/accelerating.wav"++repeatedLoadedSound :: Sound T Pulse+repeatedLoadedSound = repeatSound 20 loadedSound

@@ -1,4 +1,3 @@-import Data.Coerce (coerce) import LambdaSound  main :: IO ()@@ -16,61 +15,3 @@ -- Design a note sample note :: Semitone -> Sound I Pulse note st = easeInOut 2 $ asNote sawWave st + asNote (harmonic triangleWave) st---- -- simpleReverb 0.1 $ applyIIRFilter (highPassFilter 600 1) sound---- sound :: Sound T Pulse--- sound = melody <> background---- background :: Sound T Pulse--- background =---   repeatSound 3 $---     sequentially $---       fmap---         (setDuration 0.5)---         [ note c3,---           parallel $ note <$> [e3, g3],---           parallel $ note <$> [e3, g3],---           parallel $ note <$> [e3, g3]---         ]---- melody :: Sound T Pulse--- melody =---   let mel =---         repeatSound---           3---           ( sequentially $---               fmap---                 (setDuration 0.5)---                 [ note c4,---                   note e4,---                   note g4,---                   note e4---                 ]---           )---           >>> end---       end = setDuration 2 $ parallel [note c4, note c3, note g3]---    in mel---- note :: Semitone -> Sound T Pulse--- note st =---   applyEnvelope (Envelope 0.2 0.1 0.2 0.8) $---     setDuration 1 $---       asNote (harmonic sineWave) st---- -- Further examples---- metronome :: Sound T Pulse--- metronome = repeatSound 10 $ setDuration 1 $ note c4 >>> setDuration 2 silence---- upSound :: Sound T Pulse--- upSound =---   zipSoundWith (*) ((\p -> 1 - coerce p) <$> progress) $---     speedUp $---       upwards >>> takeSound 2 (raiseSemitones 12 upwards) >>> setDuration 1 (note g5)---- upwards :: Sound T Pulse--- upwards = setDuration 3.5 $ sequentially $ note <$> [c4, d4, e4, f4, g4, a4, b4]---- speedUp :: Sound T Pulse -> Sound T Pulse--- speedUp = changeTempo $ \p -> p ** 2

@@ -3,8 +3,7 @@ main :: IO () main = do   play 44100 1 $ setDuration (getDuration sound * 60 / 70) sound-  -- samples <- sampleSound 44100 $ setDuration (getDuration sound * 60 / 70) sound-  -- saveWav "sound.wav" 44100 samples+  -- saveWav "sound.wav" 44100 sound  sound :: Sound T Pulse sound =

@@ -0,0 +1,7 @@+import LambdaSound++main :: IO ()+main = do+    nachtmusik <- loadWav "sample-sounds/mozart-kleine-nachtmusik.wav"+    play 44100 0.4 $ takeSound 10 $ dropSound 10 nachtmusik+    

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               lambdasound-version:            1.0.1+version:            1.1 synopsis:           A libary for generating low-level sounds with high-level combinators description:        'lambdasound' can generate all kinds of sounds, play them and save them as wav or pcm data.                     Sound can be manipulated in both a low and high-level way. It is possible to @@ -38,7 +38,9 @@         LambdaSound.Sampling,         LambdaSound.Create,         LambdaSound.Convolution,-        LambdaSound.Filter+        LambdaSound.Filter,+        LambdaSound.SaveAndLoad,+        LambdaSound.SaveAndLoad.RawSamples     other-modules:         LambdaSound.Sound.ComputeSound,         LambdaSound.Sound.Types,@@ -46,7 +48,6 @@     build-depends:             base >= 4.17.0.0 && < 5,         ansi-terminal >= 1.0 && < 1.1,-        binary >= 0.8.9 && < 0.9,         bytestring >= 0.11.4 && < 0.12,         deepseq >= 1.4.8 && < 1.5,         bytestring-to-vector >= 0.3.0 && < 0.4,@@ -86,6 +87,17 @@ executable example2     import:           warnings     main-is:          Example2.hs+    build-depends:+        base ^>=4.17.0.0,+        lambdasound+    default-extensions:+        DataKinds+    hs-source-dirs:   example+    default-language: GHC2021++executable example3+    import:           warnings+    main-is:          Example3.hs     build-depends:         base ^>=4.17.0.0,         lambdasound

@@ -37,6 +37,9 @@     -- * Sample sounds,     module Sampling, +    -- * Save and load sounds+    module SaveAndLoad,+     -- * Cache sounds     module Cache,   )@@ -53,3 +56,4 @@ import LambdaSound.Samples as Sample import LambdaSound.Sampling as Sampling import LambdaSound.Sound as Sound+import LambdaSound.SaveAndLoad as SaveAndLoad

@@ -7,7 +7,6 @@ import Data.Hashable (hash) import Data.Massiv.Array qualified as M import Data.Massiv.Array.Unsafe qualified as MU-import Data.Vector.Storable qualified as V import Data.Vector.Storable.ByteString (byteStringToVector, vectorToByteString) import Data.Word import LambdaSound.Sound@@ -19,7 +18,7 @@ -- | Caches a sound. If the sound is cached, then -- the sound gets read from the XDG cache directory and does not have to -- be computed again.--- +-- -- It might load a cached sound which which is incorrect, but this should be very unlikely cache :: Sound d Pulse -> Sound d Pulse cache (TimedSound d msc) = TimedSound d $ cacheComputation msc@@ -27,31 +26,38 @@  cacheComputation :: ComputeSound Pulse -> ComputeSound Pulse cacheComputation cs = ComputeSound $ \si memo -> do-  key <- liftIO $ computeCacheKey cs-  cacheDir <- liftIO $ getXdgDirectory XdgCache "lambdasound"-  let directoryPath = joinPath [cacheDir, show key]-  liftIO $ createDirectoryIfMissing True directoryPath+  (writeSamples, ci) <- asWriteResult cs si memo -  let filePath = joinPath [directoryPath, show $ si.samples]+  let tryCache dest = do+        let memoInfo = MemoInfo si ci -  exists <- liftIO $ doesFileExist filePath-  if exists-    then do-      file <- liftIO $ BL.readFile filePath-      let floats = byteStringToVector $ toStrict $ decompress file-          (ComputeSound compute) = makeWithIndexFunction @Pulse (\_ index -> floats V.! index)-      compute si memo-    else -    do-      (writeResult, ci) <- asWriteResult cs si memo-      pure-        ( WriteResult $ \dest -> do-            writeResult dest-            floats <- MU.unsafeFreeze M.Seq dest-            let bytes = compress $ fromStrict $ vectorToByteString $ M.toStorableVector floats-            BL.writeFile filePath bytes,-          ci-        )+        memoized <- lookupMemoizedComputeSound memo memoInfo++        case memoized of+          Just memoSource -> do+            copyArrayIntoMArray memoSource dest+          Nothing -> do+            key <- liftIO $ computeCacheKey cs+            cacheDir <- liftIO $ getXdgDirectory XdgCache "lambdasound"+            let directoryPath = joinPath [cacheDir, show key]+            liftIO $ createDirectoryIfMissing True directoryPath++            let filePath = joinPath [directoryPath, show $ si.samples]++            exists <- liftIO $ doesFileExist filePath+            if exists+              then do+                file <- liftIO $ BL.readFile filePath+                let floats = M.fromStorableVector M.Seq $ byteStringToVector $ toStrict $ decompress file+                memoizeComputeSound memo memoInfo floats+                M.computeInto dest floats+              else do+                writeSamples dest+                floats <- MU.unsafeFreeze M.Seq dest+                let bytes = compress $ fromStrict $ vectorToByteString $ M.toStorableVector floats+                BL.writeFile filePath bytes++  pure (WriteResult tryCache, ci)  computeCacheKey :: ComputeSound Pulse -> IO Word64 computeCacheKey cs = do

@@ -1,14 +1,13 @@ -- | This module contains functions to sample sound and to save it in a file. -- The @LambdaSound.Play@ module exports a function to play sounds directly.-module LambdaSound.Sampling (sampleSound, sampleSoundRaw, saveWav, saveRawPCM) where+module LambdaSound.Sampling (sampleSound, sampleSoundRaw, unsampleSound, unsampleSoundWithHz) where -import Codec.Audio.Wave-import Data.ByteString qualified as B+import Data.Coerce (coerce) import Data.Massiv.Array qualified as M+import Data.Massiv.Array.Unsafe qualified as MU import LambdaSound.Sound import LambdaSound.Sound.ComputeSound (sampleComputeSound) import LambdaSound.Sound.Types (makeSamplingInfo)-import Data.Vector.Storable.ByteString (vectorToByteString)  -- | Samples a sound with the given frequency (usually 44100 is good) without post-processing sampleSoundRaw :: Hz -> Sound T Pulse -> IO (M.Vector M.S Pulse)@@ -26,11 +25,6 @@ postProcess :: (M.Source r Pulse) => M.Vector r Pulse -> M.Vector M.D Pulse postProcess = compressDynamically --- | Save the sound as raw floats-saveRawPCM :: FilePath -> M.Vector M.S Pulse -> IO ()-saveRawPCM filePath floats =-  B.writeFile filePath $ vectorToByteString $ M.toStorableVector floats- -- | Apply dynamic compression on a vector of samples such that -- they are constrained within (-1, 1). Quieter sounds are boosted -- while louder sounds are reduced.@@ -45,20 +39,28 @@     maxPulse = M.maximum' $ M.map abs signal     factor = 0.8 --- | Save a sound to a wave file with the given sampling frequency-saveWav :: FilePath -> Int -> M.Vector M.S Pulse -> IO ()-saveWav filepath sampleRate floats = do-  let floatsLength = M.unSz $ M.size floats-      wave =-        Wave-          { waveFileFormat = WaveVanilla,-            waveSampleRate = fromIntegral sampleRate,-            waveSampleFormat = SampleFormatIeeeFloat32Bit,-            waveChannelMask = speakerMono,-            waveDataOffset = 0,-            waveDataSize = fromIntegral floatsLength * 4,-            waveSamplesTotal = fromIntegral floatsLength,-            waveOtherChunks = []-          }-  writeWaveFile filepath wave $ \handle ->-    B.hPut handle $ vectorToByteString $ M.toStorableVector floats+-- | Convert a vector of samples into the 'Sound' datatype so that it can be transformed+-- with the various combinators.+--+-- Keep in mind that if you do not exactly match the size of+-- the vector and the needed amount of samples for the sound,+-- then its speed will actually change which will also affect the sound pitch.+-- Also, sub- or supersampling will happen.+unsampleSound :: (M.Source r Pulse) => M.Vector r Pulse -> Sound I Pulse+unsampleSound samples = makeSound $ \si ->+  if M.unSz (M.size samples) == si.samples+    then MU.unsafeIndex samples+    else+      let scaler :: Double = fromIntegral (M.unSz $ M.size samples) / fromIntegral si.samples+       in \i -> MU.unsafeIndex samples $ floor (fromIntegral i * scaler)++-- | Convert a vector of samples into the 'Sound' datatype so that it can be transformed+-- with the various combinators.+--+-- Given the sample rate used for the creation of the vector, the resulting sound+-- will have the same duration as the original sound. However, sub- and supersampling will still happen+-- similarly to `unsampleSound` and changing the 'Duration' also changes the pitch.+unsampleSoundWithHz :: (M.Source r Pulse) => Hz -> M.Vector r Pulse -> Sound T Pulse+unsampleSoundWithHz hz samples = setDuration d $ unsampleSound samples+  where+    d = coerce $ fromIntegral (M.unSz $ M.size samples) / hz

@@ -0,0 +1,61 @@+-- | This module exports some functions for simple loading and saving sounds. +--+-- However, keep in mind that loaded sounds have a fixed amound of samples and thus cannot be stretched+-- in duration losslessly. Stretching a sound results in sub- or supersampling and will also shift the pitch.+-- Pitch-retaining stretching has not been implemented yet!+module LambdaSound.SaveAndLoad+  ( saveWav,+    loadWav,+    saveRaw,+    loadRaw,+    saveRawCompressed,+    loadRawCompressed,+  )+where++import Data.List.NonEmpty+import LambdaSound.Sampling (sampleSound, unsampleSound, unsampleSoundWithHz)+import LambdaSound.SaveAndLoad.RawSamples qualified as RS+import LambdaSound.Sound++-- | Save a sound as a wav file using default 'sampleSound'.+saveWav :: FilePath -> Hz -> Sound T Pulse -> IO ()+saveWav filePath hz sound = do+  floats <- sampleSound hz sound+  RS.saveWav filePath hz floats++-- | Load a wav as a sound, mixing channels with 'parallel2'.+--+-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!+loadWav :: FilePath -> IO (Sound T Pulse)+loadWav filePath = do+  (hz, channels) <- RS.loadWav filePath+  pure $ unsampleSoundWithHz hz $ Data.List.NonEmpty.head channels++-- | Save a sound as floats.+saveRaw :: FilePath -> Hz -> Sound T Pulse -> IO ()+saveRaw filePath hz sound = do+  floats <- sampleSound hz sound+  RS.saveRaw filePath floats++-- | Load a sound from floats.+--+-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!+loadRaw :: FilePath -> IO (Sound I Pulse)+loadRaw filePath = do+  floats <- RS.loadRaw filePath+  pure $ unsampleSound floats++-- | Save a sound as gzip-compressed floats.+saveRawCompressed :: FilePath -> Hz -> Sound T Pulse -> IO ()+saveRawCompressed filePath hz sound = do+  floats <- sampleSound hz sound+  RS.saveRawCompressed filePath floats++-- | Load a sound from gzip-compressed floats.+--+-- If you want to to use this with `embedIO`, you should probably use `embedIOLazily` instead!+loadRawCompressed :: FilePath -> IO (Sound I Pulse)+loadRawCompressed filePath = do+  floats <- RS.loadRawCompressed filePath+  pure $ unsampleSound floats

@@ -0,0 +1,103 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module LambdaSound.SaveAndLoad.RawSamples+  ( saveWav,+    saveRaw,+    saveRawCompressed,+    loadWav,+    loadRaw,+    loadRawCompressed,+  )+where++import Codec.Audio.Wave+import Codec.Compression.GZip (compress, decompress)+import Control.Monad.IO.Class (liftIO)+import Data.ByteString qualified as B+import Data.ByteString.Lazy qualified as BL+import Data.Functor ((<&>))+import Data.Int (Int16, Int32, Int64)+import Data.List.NonEmpty+import Data.Massiv.Array qualified as M+import Data.Semigroup (Max (..))+import Data.Vector.Storable.ByteString (byteStringToVector, vectorToByteString)+import Data.Word (Word8)+import LambdaSound.Sound (Hz, Pulse)++-- | Save sound samples to a wave file with the given sampling frequency+saveWav :: FilePath -> Hz -> M.Vector M.S Pulse -> IO ()+saveWav filepath sampleRate floats = do+  let floatsLength = M.unSz $ M.size floats+      wave =+        Wave+          { waveFileFormat = WaveVanilla,+            waveSampleRate = round sampleRate,+            waveSampleFormat = SampleFormatIeeeFloat32Bit,+            waveChannelMask = speakerMono,+            waveDataOffset = 0,+            waveDataSize = fromIntegral floatsLength * 4,+            waveSamplesTotal = fromIntegral floatsLength,+            waveOtherChunks = []+          }+  writeWaveFile filepath wave $ \handle ->+    B.hPut handle $ vectorToByteString $ M.toStorableVector floats++-- | Load a wave file to get the sampling frequencies and the sound samples for the channels.+loadWav :: FilePath -> IO (Hz, NonEmpty (M.Vector M.S Pulse))+loadWav filePath = do+  wave <- readWaveFile filePath+  file <- B.readFile filePath+  let sourceVector = readSource wave $ B.drop (fromIntegral $ waveDataOffset wave) file+  pure (fromIntegral $ waveSampleRate wave, splitInChannels wave sourceVector)+  where+    splitInChannels :: Wave -> M.Vector M.D Pulse -> NonEmpty (M.Vector M.S Pulse)+    splitInChannels wave sourceVector =+      let channels = fromIntegral $ waveChannels wave+       in fromList $+            if channels == 1+              then [M.compute sourceVector]+              else+                [0 .. pred channels] <&> \channelOffset ->+                  M.compute $ M.downsample (M.Stride channels) $ M.drop (M.Sz1 channelOffset) sourceVector+    readSource :: Wave -> B.ByteString -> M.Vector M.D Pulse+    readSource wave sampleData =+      case waveSampleFormat wave of+        SampleFormatIeeeFloat32Bit -> mapAndLoad @Float+        SampleFormatIeeeFloat64Bit -> mapAndLoad @Double+        SampleFormatPcmInt 8 -> M.map ((+ (-1)) . (* 2)) $ mapAndLoad @Word8+        SampleFormatPcmInt 16 -> mapAndLoad @Int16+        SampleFormatPcmInt 32 -> mapAndLoad @Int32+        SampleFormatPcmInt 64 -> mapAndLoad @Int64+        _ -> error $ "The sample format \"" <> show (waveSampleFormat wave) <> "\" is not supported"+      where+        mapAndLoad :: forall a. (Real a, Num a, M.Storable a) => M.Vector M.D Pulse+        mapAndLoad =+          let rawArray =+                M.fromStorableVector @a M.Seq $+                  byteStringToVector sampleData+              (Max maxSample) = realToFrac <$> M.foldSemi (Max . abs) (Max 0) rawArray+           in M.map ((/ maxSample) . realToFrac) rawArray+        {-# INLINE mapAndLoad #-}++-- | Save the sound samples as raw floats+saveRaw :: FilePath -> M.Vector M.S Pulse -> IO ()+saveRaw filePath floats =+  B.writeFile filePath $ vectorToByteString $ M.toStorableVector floats++-- | Save the sound samples as raw floats compressed with gzip+saveRawCompressed :: FilePath -> M.Vector M.S Pulse -> IO ()+saveRawCompressed filePath floats = do+  let bytes = compress $ BL.fromStrict $ vectorToByteString $ M.toStorableVector floats+  BL.writeFile filePath bytes++-- Load the gzip compressed raw sound samples+loadRawCompressed :: FilePath -> IO (M.Vector M.S Pulse)+loadRawCompressed filePath = do+  file <- liftIO $ BL.readFile filePath+  pure $ M.fromStorableVector M.Seq $ byteStringToVector $ BL.toStrict $ decompress file++-- Load the raw sound samples+loadRaw :: FilePath -> IO (M.Vector M.S Pulse)+loadRaw filePath = do+  file <- liftIO $ B.readFile filePath+  pure $ M.fromStorableVector M.Seq $ byteStringToVector file

@@ -69,6 +69,10 @@     withSamplingInfo,     withSampledSound,     withSampledSoundPulse,++    -- * Embed IO+    embedIO,+    embedIOLazily,   ) where @@ -399,3 +403,16 @@ -- Take a look at @LambdaSound.Create@ for other creation functions. makeSoundVector :: (SamplingInfo -> M.Vector M.D a) -> Sound I a makeSoundVector f = InfiniteSound $ makeDelayedResult f++-- | Embed an IO calculation when generating an infinite sound.+--+-- This IO action will be run each time the sound is used.+embedIO :: IO (Sound d a) -> Sound I a+embedIO ioSound = InfiniteSound $ embedIOCS $ getCS <$> ioSound++-- | Embed an IO calculation lazily when generating an infinite sound.+--+-- This IO action will not necessarily run each time the sound is used due to memoization.+-- The IO action will run at least once and at most as often as the sound occurs.+embedIOLazily :: IO (Sound d a) -> Sound I a+embedIOLazily ioSound = InfiniteSound $ embedIOLazilyCS $ getCS <$> ioSound

@@ -1,5 +1,6 @@ module LambdaSound.Sound.ComputeSound where +import Control.Monad (join) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.HashTable.IO qualified as H import Data.Hashable@@ -21,7 +22,7 @@ makeDelayedResult :: (SamplingInfo -> M.Vector M.D a) -> ComputeSound a makeDelayedResult f = ComputeSound $ \si _ -> do   stableF <- makeSomeStableName f-  pure (DelayedResult $ f si, ComputationInfoMakeDelayedResult stableF)+  pure (DelayedResult $ pure $ f si, ComputationInfoMakeDelayedResult stableF) {-# INLINE makeDelayedResult #-}  changeSamplingInfo :: (SamplingInfo -> SamplingInfo) -> ComputeSound a -> ComputeSound a@@ -36,13 +37,15 @@   (delayedVector, ci) <- asDelayedResult cs si memo   stableMapVector <- makeSomeStableName mapVector   let mapVector' = mapVector si-  pure (DelayedResult $ mapVector' delayedVector, ComputationInfoMapDelayedResult stableMapVector ci)+  pure (DelayedResult $ fmap mapVector' delayedVector, ComputationInfoMapDelayedResult stableMapVector ci) {-# INLINE mapDelayedResult #-}  withSamplingInfoCS :: (SamplingInfo -> ComputeSound a) -> ComputeSound a-withSamplingInfoCS f = ComputeSound $ \si memo ->+withSamplingInfoCS f = ComputeSound $ \si memo -> do+  stableF <- makeSomeStableName f   let (ComputeSound compute) = f si-   in compute si memo+  (res, _) <- compute si memo+  pure (res, ComputationInfoWithSamplingInfo stableF) {-# INLINE withSamplingInfoCS #-}  withSampledSoundPulseCS :: Duration -> ComputeSound Pulse -> (M.Vector M.S Pulse -> ComputeSound a) -> ComputeSound a@@ -62,10 +65,14 @@ withSampledSoundCS duration cs f = ComputeSound $ \si memo -> do   let sampleSI = makeSamplingInfo si.sampleRate duration   (delayedVector, ci) <- asDelayedResult cs sampleSI memo-  let (ComputeSound compute) = f delayedVector-  (res, _) <- compute si memo+  let nextCS = f <$> delayedVector   stableF <- makeSomeStableName f-  pure (res, ComputationInfoWithSampledSound stableF ci)+  pure+    ( DelayedResult $ do+        (finalDelayedVector, _) <- join $ asDelayedResult <$> nextCS <*> pure si <*> pure memo+        finalDelayedVector,+      ComputationInfoWithSampledSound stableF ci+    ) {-# INLINE withSampledSoundCS #-}  mergeDelayedResult :: (SamplingInfo -> M.Vector M.D a -> M.Vector M.D b -> M.Vector M.D c) -> ComputeSound a -> ComputeSound b -> ComputeSound c@@ -74,7 +81,7 @@   (delayedResult1, ci1) <- asDelayedResult cs1 si memo   (delayedResult2, ci2) <- asDelayedResult cs2 si memo   let merge' = merge si-  pure (DelayedResult $ merge' delayedResult1 delayedResult2, ComputationInfoMergeDelayedResult stableMerge ci1 ci2)+  pure (DelayedResult $ merge' <$> delayedResult1 <*> delayedResult2, ComputationInfoMergeDelayedResult stableMerge ci1 ci2) {-# INLINE mergeDelayedResult #-}  computeSequentially :: Percentage -> ComputeSound Pulse -> ComputeSound Pulse -> ComputeSound Pulse@@ -99,8 +106,11 @@   (delayedResult2, p2) <- asDelayedResult c2 si {samples = c2N} memo   pure     ( if si.samples == c2N-        then DelayedResult $ M.zipWith (+) delayedResult1 delayedResult2-        else DelayedResult $ M.imap (\index -> (+) $ if index < c2N then MU.unsafeIndex delayedResult2 index else 0) delayedResult1,+        then DelayedResult $ M.zipWith (+) <$> delayedResult1 <*> delayedResult2+        else DelayedResult $ do+          dR1 <- delayedResult1+          dR2 <- delayedResult2+          pure $ M.imap (\index -> (+) $ if index < c2N then MU.unsafeIndex dR2 index else 0) dR1,       ComputationInfoParallel factor p1 p2     ) {-# INLINE computeParallel #-}@@ -109,24 +119,27 @@ mapComputeSound f cs = ComputeSound $ \si memo -> do   stableF <- makeSomeStableName f   (result, ci) <- asDelayedResult cs si memo-  pure (DelayedResult $ M.map f result, ComputationInfoMap stableF ci)+  pure (DelayedResult $ M.map f <$> result, ComputationInfoMap stableF ci) {-# INLINE mapComputeSound #-}  asDelayedResult ::   ComputeSound a ->   SamplingInfo ->   MemoComputeSound ->-  IO (M.Vector M.D a, ComputationInfo)+  IO (IO (M.Vector M.D a), ComputationInfo) asDelayedResult (ComputeSound compute) si memo = do   (result, ci) <- compute si memo   case result of     DelayedResult vector -> pure (vector, ci)-    WriteResult writeResult -> do-      marray <- MU.unsafeMallocMArray (M.Sz1 si.samples)-      writeResult marray-      array <- MU.unsafeFreeze M.Seq marray--      pure (M.delay array, ci)+    WriteResult writeResult ->+      pure+        ( do+            marray <- MU.unsafeMallocMArray (M.Sz1 si.samples)+            writeResult marray+            array <- MU.unsafeFreeze M.Seq marray+            pure $ M.delay array,+          ci+        ) {-# INLINE asDelayedResult #-}  asWriteResult ::@@ -143,11 +156,12 @@       pure         ( \dest -> do             memoized <- lookupMemoizedComputeSound memo memoInfo+             case memoized of-              Just memoSource ->+              Just memoSource -> do                 copyArrayIntoMArray memoSource dest               Nothing -> do-                M.computeInto dest vector+                vector >>= M.computeInto dest                 destArray <- MU.unsafeFreeze M.Seq dest                 memoizeComputeSound memo memoInfo destArray,           ci@@ -159,7 +173,7 @@   (dV1, p1) <- asDelayedResult cs1 si memo   (dV2, p2) <- asDelayedResult cs2 si memo   stableF <- makeSomeStableName f-  pure (DelayedResult $ M.zipWith f dV1 dV2, ComputationInfoZip stableF p1 p2)+  pure (DelayedResult $ M.zipWith f <$> dV1 <*> dV2, ComputationInfoZip stableF p1 p2) {-# INLINE zipWithCompute #-}  mapSoundFromMemory :: (M.Load r M.Ix1 Pulse) => (M.Vector M.S Pulse -> M.Vector r Pulse) -> ComputeSound Pulse -> ComputeSound Pulse@@ -201,6 +215,25 @@     ) {-# INLINE fillSoundInMemoryIO #-} +embedIOCS :: IO (ComputeSound a) -> ComputeSound a+embedIOCS makeCS = ComputeSound $ \si memo -> do+  stableIO <- makeSomeStableName makeCS+  (ComputeSound compute) <- makeCS+  (res, _) <- compute si memo+  pure (res, ComputationInfoIO stableIO)+{-# INLINE embedIOCS #-}++embedIOLazilyCS :: IO (ComputeSound a) -> ComputeSound a+embedIOLazilyCS makeCS = ComputeSound $ \si memo -> do+  stableIO <- makeSomeStableName makeCS+  pure+    ( DelayedResult $ do+        (res, _) <- join $ asDelayedResult <$> makeCS <*> pure si <*> pure memo+        res,+      ComputationInfoIO stableIO+    )+{-# INLINE embedIOLazilyCS #-}+ pulseSize :: Int pulseSize = sizeOf (undefined :: Pulse) {-# INLINE pulseSize #-}@@ -243,7 +276,7 @@  data SoundResult a where   WriteResult :: (M.MVector M.RealWorld M.S Pulse -> IO ()) -> SoundResult Pulse-  DelayedResult :: M.Vector M.D a -> SoundResult a+  DelayedResult :: IO (M.Vector M.D a) -> SoundResult a  data ComputationInfo   = ComputationInfoZip SomeStableName ComputationInfo ComputationInfo@@ -256,7 +289,9 @@   | ComputationInfoMapMemory SomeStableName ComputationInfo   | ComputationInfoFillMemory SomeStableName   | ComputationInfoChangeSamplingInfo SomeStableName ComputationInfo-  | ComputationInfoWithSampledSound  SomeStableName ComputationInfo+  | ComputationInfoWithSampledSound SomeStableName ComputationInfo+  | ComputationInfoIO SomeStableName+  | ComputationInfoWithSamplingInfo SomeStableName   deriving (Eq, Generic, Show)  instance Hashable ComputationInfo

@@ -20,7 +20,7 @@ newtype Percentage = Percentage Float deriving (Show, Eq, Floating, Num, Fractional, Ord, Real, RealFrac, NFData, Storable, Hashable, Enum)  -- | Hz are the unit for frequencies. 440 Hz means that 440 oscillations happen per second-newtype Hz = Hz Float deriving (Show, Eq, Ord, Num, Fractional, Floating, Enum, Generic)+newtype Hz = Hz Float deriving (Show, Eq, Ord, Num, Fractional, Floating, Enum, Generic, Real, RealFrac)  -- | Time progresses while a 'Sound' is playing and is used to create samples. -- It is not guaranteed that 'Time' will correspond to the real runtime of a 'Sound'