module Sound.Audacity.Project.Track.Wave where

import qualified Sound.Audacity.Project.Track.Wave.Summary as Summary

import qualified Sound.Audacity.XML.Attribute as Attr
import qualified Sound.Audacity.XML as XML

import qualified Text.HTML.Tagchup.Tag as Tag
import qualified Text.XML.Basic.Name.MixedCase as Name

import qualified Data.ByteString.Char8 as BS
import Text.Printf (printf)

import qualified System.IO as IO
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))

import qualified Data.StorableVector.Lazy as SVL

import qualified Data.NonEmpty as NonEmpty
import qualified Data.List as List
import Data.NonEmpty ((!:))
import Data.Tuple.HT (mapSnd)

import qualified Control.Monad.Trans.Reader as MR
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad (liftM)


import Prelude hiding (sequence_)


data T =
   Cons {
      T -> String
name_ :: String,
      T -> Channel
channel_ :: Channel,
      T -> Bool
linked_, T -> Bool
mute_, T -> Bool
solo_, T -> Bool
minimized_ :: Bool,
      T -> Int
height_ :: Int,
      T -> Int
rate_ :: Int,
      T -> Double
gain_, T -> Double
pan_ :: Double,
      T -> [Clip]
clips_ :: [Clip]
   }
   deriving Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show

deflt :: T
deflt :: T
deflt =
   Cons :: String
-> Channel
-> Bool
-> Bool
-> Bool
-> Bool
-> Int
-> Int
-> Double
-> Double
-> [Clip]
-> T
Cons {
      name_ :: String
name_ = String
"",
      channel_ :: Channel
channel_ = Channel
Mono,
      linked_ :: Bool
linked_ = Bool
False, mute_ :: Bool
mute_ = Bool
False, solo_ :: Bool
solo_ = Bool
False,
      minimized_ :: Bool
minimized_ = Bool
False,
      height_ :: Int
height_ = Int
150,
      rate_ :: Int
rate_ = Int
44100,
      gain_ :: Double
gain_ = Double
1.0,
      pan_ :: Double
pan_ = Double
0.0,
      clips_ :: [Clip]
clips_ = []
   }

data Channel = Left | Right | Mono
   deriving (Channel -> Channel -> Bool
(Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool) -> Eq Channel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq, Eq Channel
Eq Channel
-> (Channel -> Channel -> Ordering)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Channel)
-> (Channel -> Channel -> Channel)
-> Ord Channel
Channel -> Channel -> Bool
Channel -> Channel -> Ordering
Channel -> Channel -> Channel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmax :: Channel -> Channel -> Channel
>= :: Channel -> Channel -> Bool
$c>= :: Channel -> Channel -> Bool
> :: Channel -> Channel -> Bool
$c> :: Channel -> Channel -> Bool
<= :: Channel -> Channel -> Bool
$c<= :: Channel -> Channel -> Bool
< :: Channel -> Channel -> Bool
$c< :: Channel -> Channel -> Bool
compare :: Channel -> Channel -> Ordering
$ccompare :: Channel -> Channel -> Ordering
$cp1Ord :: Eq Channel
Ord, Int -> Channel
Channel -> Int
Channel -> [Channel]
Channel -> Channel
Channel -> Channel -> [Channel]
Channel -> Channel -> Channel -> [Channel]
(Channel -> Channel)
-> (Channel -> Channel)
-> (Int -> Channel)
-> (Channel -> Int)
-> (Channel -> [Channel])
-> (Channel -> Channel -> [Channel])
-> (Channel -> Channel -> [Channel])
-> (Channel -> Channel -> Channel -> [Channel])
-> Enum Channel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Channel -> Channel -> Channel -> [Channel]
$cenumFromThenTo :: Channel -> Channel -> Channel -> [Channel]
enumFromTo :: Channel -> Channel -> [Channel]
$cenumFromTo :: Channel -> Channel -> [Channel]
enumFromThen :: Channel -> Channel -> [Channel]
$cenumFromThen :: Channel -> Channel -> [Channel]
enumFrom :: Channel -> [Channel]
$cenumFrom :: Channel -> [Channel]
fromEnum :: Channel -> Int
$cfromEnum :: Channel -> Int
toEnum :: Int -> Channel
$ctoEnum :: Int -> Channel
pred :: Channel -> Channel
$cpred :: Channel -> Channel
succ :: Channel -> Channel
$csucc :: Channel -> Channel
Enum, Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
(Int -> Channel -> ShowS)
-> (Channel -> String) -> ([Channel] -> ShowS) -> Show Channel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show)


data Clip =
   Clip {
      Clip -> Double
offset_ :: Double,
      Clip -> Sequence
sequence_ :: Sequence
      -- envelope_ :: Envelope
   }
   deriving Int -> Clip -> ShowS
[Clip] -> ShowS
Clip -> String
(Int -> Clip -> ShowS)
-> (Clip -> String) -> ([Clip] -> ShowS) -> Show Clip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clip] -> ShowS
$cshowList :: [Clip] -> ShowS
show :: Clip -> String
$cshow :: Clip -> String
showsPrec :: Int -> Clip -> ShowS
$cshowsPrec :: Int -> Clip -> ShowS
Show


data Sequence =
   Sequence {
      Sequence -> Int
maxSamples_ :: Int,
      -- the sampleformat attribute seems to have no effect
      Sequence -> SampleFormat
sampleFormat_ :: SampleFormat,
      Sequence -> Int
numSamples_ :: Int,
      Sequence -> [Block]
blocks_ :: [Block]
   }
   deriving Int -> Sequence -> ShowS
[Sequence] -> ShowS
Sequence -> String
(Int -> Sequence -> ShowS)
-> (Sequence -> String) -> ([Sequence] -> ShowS) -> Show Sequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sequence] -> ShowS
$cshowList :: [Sequence] -> ShowS
show :: Sequence -> String
$cshow :: Sequence -> String
showsPrec :: Int -> Sequence -> ShowS
$cshowsPrec :: Int -> Sequence -> ShowS
Show

-- cf. audacity:SampleFormat.h
data SampleFormat = Int16Sample | Int24Sample | FloatSample
   deriving (SampleFormat -> SampleFormat -> Bool
(SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool) -> Eq SampleFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleFormat -> SampleFormat -> Bool
$c/= :: SampleFormat -> SampleFormat -> Bool
== :: SampleFormat -> SampleFormat -> Bool
$c== :: SampleFormat -> SampleFormat -> Bool
Eq, Eq SampleFormat
Eq SampleFormat
-> (SampleFormat -> SampleFormat -> Ordering)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> Bool)
-> (SampleFormat -> SampleFormat -> SampleFormat)
-> (SampleFormat -> SampleFormat -> SampleFormat)
-> Ord SampleFormat
SampleFormat -> SampleFormat -> Bool
SampleFormat -> SampleFormat -> Ordering
SampleFormat -> SampleFormat -> SampleFormat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SampleFormat -> SampleFormat -> SampleFormat
$cmin :: SampleFormat -> SampleFormat -> SampleFormat
max :: SampleFormat -> SampleFormat -> SampleFormat
$cmax :: SampleFormat -> SampleFormat -> SampleFormat
>= :: SampleFormat -> SampleFormat -> Bool
$c>= :: SampleFormat -> SampleFormat -> Bool
> :: SampleFormat -> SampleFormat -> Bool
$c> :: SampleFormat -> SampleFormat -> Bool
<= :: SampleFormat -> SampleFormat -> Bool
$c<= :: SampleFormat -> SampleFormat -> Bool
< :: SampleFormat -> SampleFormat -> Bool
$c< :: SampleFormat -> SampleFormat -> Bool
compare :: SampleFormat -> SampleFormat -> Ordering
$ccompare :: SampleFormat -> SampleFormat -> Ordering
$cp1Ord :: Eq SampleFormat
Ord, Int -> SampleFormat
SampleFormat -> Int
SampleFormat -> [SampleFormat]
SampleFormat -> SampleFormat
SampleFormat -> SampleFormat -> [SampleFormat]
SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
(SampleFormat -> SampleFormat)
-> (SampleFormat -> SampleFormat)
-> (Int -> SampleFormat)
-> (SampleFormat -> Int)
-> (SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> [SampleFormat])
-> (SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat])
-> Enum SampleFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
$cenumFromThenTo :: SampleFormat -> SampleFormat -> SampleFormat -> [SampleFormat]
enumFromTo :: SampleFormat -> SampleFormat -> [SampleFormat]
$cenumFromTo :: SampleFormat -> SampleFormat -> [SampleFormat]
enumFromThen :: SampleFormat -> SampleFormat -> [SampleFormat]
$cenumFromThen :: SampleFormat -> SampleFormat -> [SampleFormat]
enumFrom :: SampleFormat -> [SampleFormat]
$cenumFrom :: SampleFormat -> [SampleFormat]
fromEnum :: SampleFormat -> Int
$cfromEnum :: SampleFormat -> Int
toEnum :: Int -> SampleFormat
$ctoEnum :: Int -> SampleFormat
pred :: SampleFormat -> SampleFormat
$cpred :: SampleFormat -> SampleFormat
succ :: SampleFormat -> SampleFormat
$csucc :: SampleFormat -> SampleFormat
Enum, SampleFormat
SampleFormat -> SampleFormat -> Bounded SampleFormat
forall a. a -> a -> Bounded a
maxBound :: SampleFormat
$cmaxBound :: SampleFormat
minBound :: SampleFormat
$cminBound :: SampleFormat
Bounded, Int -> SampleFormat -> ShowS
[SampleFormat] -> ShowS
SampleFormat -> String
(Int -> SampleFormat -> ShowS)
-> (SampleFormat -> String)
-> ([SampleFormat] -> ShowS)
-> Show SampleFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleFormat] -> ShowS
$cshowList :: [SampleFormat] -> ShowS
show :: SampleFormat -> String
$cshow :: SampleFormat -> String
showsPrec :: Int -> SampleFormat -> ShowS
$cshowsPrec :: Int -> SampleFormat -> ShowS
Show)

intFromSampleFormat :: SampleFormat -> Int
intFromSampleFormat :: SampleFormat -> Int
intFromSampleFormat SampleFormat
fmt =
   case SampleFormat
fmt of
      SampleFormat
Int16Sample -> Int
0x00020001
      SampleFormat
Int24Sample -> Int
0x00040001
      SampleFormat
FloatSample -> Int
0x0004000F


data Block =
   Block {
      Block -> Int
blockStart_, Block -> Int
blockLength_ :: Int,
      Block -> BlockFile
blockFile_ :: BlockFile
   }
   deriving Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show

data BlockFile =
   PCMAliasBlockFile {
      BlockFile -> String
summaryFile_, BlockFile -> String
aliasFile_ :: FilePath,
      BlockFile -> Int
aliasStart_ :: Int,
      -- aliasLength_ :: Int,   replaced by blockLength
      BlockFile -> Int
aliasChannel_ :: Int,
      BlockFile -> Limits
limits_ :: Summary.Limits
   }
   deriving Int -> BlockFile -> ShowS
[BlockFile] -> ShowS
BlockFile -> String
(Int -> BlockFile -> ShowS)
-> (BlockFile -> String)
-> ([BlockFile] -> ShowS)
-> Show BlockFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockFile] -> ShowS
$cshowList :: [BlockFile] -> ShowS
show :: BlockFile -> String
$cshow :: BlockFile -> String
showsPrec :: Int -> BlockFile -> ShowS
$cshowsPrec :: Int -> BlockFile -> ShowS
Show


toXML :: T -> [[Tag.T Name.T String]]
toXML :: T -> [[T T String]]
toXML T
x =
   String
-> T -> [T T (T -> String)] -> [[T T String]] -> [[T T String]]
forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
XML.tag String
"wavetrack" T
x
      (String -> (T -> String) -> T T (T -> String)
forall a. String -> (a -> String) -> T T (a -> String)
Attr.string String
"name" T -> String
name_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Channel) -> T T (T -> String)
forall b a. Enum b => String -> (a -> b) -> T T (a -> String)
Attr.enum String
"channel" T -> Channel
channel_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Bool) -> T T (T -> String)
forall a. String -> (a -> Bool) -> T T (a -> String)
Attr.bool String
"linked" T -> Bool
linked_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Bool) -> T T (T -> String)
forall a. String -> (a -> Bool) -> T T (a -> String)
Attr.bool String
"mute" T -> Bool
mute_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Bool) -> T T (T -> String)
forall a. String -> (a -> Bool) -> T T (a -> String)
Attr.bool String
"solo" T -> Bool
solo_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Int) -> T T (T -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"height" T -> Int
height_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Bool) -> T T (T -> String)
forall a. String -> (a -> Bool) -> T T (a -> String)
Attr.bool String
"minimized" T -> Bool
minimized_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Int) -> T T (T -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"rate" T -> Int
rate_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Double) -> T T (T -> String)
forall a. String -> (a -> Double) -> T T (a -> String)
Attr.double String
"gain" T -> Double
gain_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       String -> (T -> Double) -> T T (T -> String)
forall a. String -> (a -> Double) -> T T (a -> String)
Attr.double String
"pan" T -> Double
pan_ T T (T -> String) -> [T T (T -> String)] -> [T T (T -> String)]
forall a. a -> [a] -> [a]
:
       [])
      ((Clip -> [[T T String]]) -> [Clip] -> [[T T String]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Clip -> [[T T String]]
clipToXML (T -> [Clip]
clips_ T
x))

clipToXML :: Clip -> [[Tag.T Name.T String]]
clipToXML :: Clip -> [[T T String]]
clipToXML Clip
x =
   String
-> Clip
-> [T T (Clip -> String)]
-> [[T T String]]
-> [[T T String]]
forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
XML.tag String
"waveclip" Clip
x
      (String -> (Clip -> String) -> T T (Clip -> String)
forall a. String -> (a -> String) -> T T (a -> String)
Attr.string String
"offset" (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.8f" (Double -> String) -> (Clip -> Double) -> Clip -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clip -> Double
offset_) T T (Clip -> String)
-> [T T (Clip -> String)] -> [T T (Clip -> String)]
forall a. a -> [a] -> [a]
:
       [])
      (Sequence -> [[T T String]]
sequenceToXML (Clip -> Sequence
sequence_ Clip
x))

sequenceToXML :: Sequence -> [[Tag.T Name.T String]]
sequenceToXML :: Sequence -> [[T T String]]
sequenceToXML Sequence
x =
   String
-> Sequence
-> [T T (Sequence -> String)]
-> [[T T String]]
-> [[T T String]]
forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
XML.tag String
"sequence" Sequence
x
      (String -> (Sequence -> Int) -> T T (Sequence -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"maxsamples" Sequence -> Int
maxSamples_ T T (Sequence -> String)
-> [T T (Sequence -> String)] -> [T T (Sequence -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Sequence -> Int) -> T T (Sequence -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"numsamples" Sequence -> Int
numSamples_ T T (Sequence -> String)
-> [T T (Sequence -> String)] -> [T T (Sequence -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Sequence -> Int) -> T T (Sequence -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"sampleformat" (SampleFormat -> Int
intFromSampleFormat (SampleFormat -> Int)
-> (Sequence -> SampleFormat) -> Sequence -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence -> SampleFormat
sampleFormat_) T T (Sequence -> String)
-> [T T (Sequence -> String)] -> [T T (Sequence -> String)]
forall a. a -> [a] -> [a]
:
       [])
      ((Block -> [[T T String]]) -> [Block] -> [[T T String]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [[T T String]]
blockToXML (Sequence -> [Block]
blocks_ Sequence
x))

blockToXML :: Block -> [[Tag.T Name.T String]]
blockToXML :: Block -> [[T T String]]
blockToXML Block
x =
   String
-> Block
-> [T T (Block -> String)]
-> [[T T String]]
-> [[T T String]]
forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
XML.tag String
"waveblock" Block
x
      (String -> (Block -> Int) -> T T (Block -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"start" Block -> Int
blockStart_ T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       [])
   ([[T T String]] -> [[T T String]])
-> [[T T String]] -> [[T T String]]
forall a b. (a -> b) -> a -> b
$
   String
-> Block
-> [T T (Block -> String)]
-> [[T T String]]
-> [[T T String]]
forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
XML.tag String
"pcmaliasblockfile" Block
x
      (String -> (Block -> String) -> T T (Block -> String)
forall a. String -> (a -> String) -> T T (a -> String)
Attr.string String
"summaryfile" (BlockFile -> String
summaryFile_ (BlockFile -> String) -> (Block -> BlockFile) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> String) -> T T (Block -> String)
forall a. String -> (a -> String) -> T T (a -> String)
Attr.string String
"aliasfile" (BlockFile -> String
aliasFile_ (BlockFile -> String) -> (Block -> BlockFile) -> Block -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Int) -> T T (Block -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"aliasstart" (BlockFile -> Int
aliasStart_ (BlockFile -> Int) -> (Block -> BlockFile) -> Block -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Int) -> T T (Block -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"aliaslen" Block -> Int
blockLength_ T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Int) -> T T (Block -> String)
forall a. String -> (a -> Int) -> T T (a -> String)
Attr.int String
"aliaschannel" (BlockFile -> Int
aliasChannel_ (BlockFile -> Int) -> (Block -> BlockFile) -> Block -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Float) -> T T (Block -> String)
forall a. String -> (a -> Float) -> T T (a -> String)
Attr.float String
"min" (Limits -> Float
Summary.min_ (Limits -> Float) -> (Block -> Limits) -> Block -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockFile -> Limits
limits_ (BlockFile -> Limits) -> (Block -> BlockFile) -> Block -> Limits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Float) -> T T (Block -> String)
forall a. String -> (a -> Float) -> T T (a -> String)
Attr.float String
"max" (Limits -> Float
Summary.max_ (Limits -> Float) -> (Block -> Limits) -> Block -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockFile -> Limits
limits_ (BlockFile -> Limits) -> (Block -> BlockFile) -> Block -> Limits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       String -> (Block -> Float) -> T T (Block -> String)
forall a. String -> (a -> Float) -> T T (a -> String)
Attr.float String
"rms" (Limits -> Float
Summary.rms_ (Limits -> Float) -> (Block -> Limits) -> Block -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockFile -> Limits
limits_ (BlockFile -> Limits) -> (Block -> BlockFile) -> Block -> Limits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> BlockFile
blockFile_) T T (Block -> String)
-> [T T (Block -> String)] -> [T T (Block -> String)]
forall a. a -> [a] -> [a]
:
       [])
      []


{- |
@maxSamples_@ must be at least 1024,
otherwise you get an error about clip values
if you load the project to Audacity.
However, 1024 is not necessarily a good value.
Audacity uses 524288 by default.
-}
{-
Alternatively we could omit the @maxsamples@ attribute
when writing the XML file.
The DTD says that the @maxsamples@ attribute is required,
but Audacity accepts when it is missing.
-}
pcmAliasSequence ::
   (Monad m) =>
   SampleFormat -> Int -> Int -> FilePath -> Int -> Summary.Monad m Sequence
pcmAliasSequence :: SampleFormat -> Int -> Int -> String -> Int -> Monad m Sequence
pcmAliasSequence SampleFormat
fmt Int
blockSize Int
totalSize String
path Int
channel =
   ([Block] -> Sequence)
-> ReaderT String (StateT State m) [Block] -> Monad m Sequence
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (\[Block]
bs ->
         Sequence :: Int -> SampleFormat -> Int -> [Block] -> Sequence
Sequence {
            maxSamples_ :: Int
maxSamples_ = Int
blockSize,
            numSamples_ :: Int
numSamples_ = Int
totalSize,
            sampleFormat_ :: SampleFormat
sampleFormat_ = SampleFormat
fmt,
            blocks_ :: [Block]
blocks_ = [Block]
bs
         }) (ReaderT String (StateT State m) [Block] -> Monad m Sequence)
-> ReaderT String (StateT State m) [Block] -> Monad m Sequence
forall a b. (a -> b) -> a -> b
$
   (Int -> ReaderT String (StateT State m) Block)
-> [Int] -> ReaderT String (StateT State m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      (\Int
start -> do
         (Summary.State Int
n) <- Monad m State
forall (m :: * -> *). Monad m => Monad m State
Summary.reserve
         Block -> ReaderT String (StateT State m) Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> ReaderT String (StateT State m) Block)
-> Block -> ReaderT String (StateT State m) Block
forall a b. (a -> b) -> a -> b
$
            Block :: Int -> Int -> BlockFile -> Block
Block {
               blockStart_ :: Int
blockStart_ = Int
start,
               blockLength_ :: Int
blockLength_ = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
totalSize (Int
startInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
blockSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start,
               blockFile_ :: BlockFile
blockFile_ =
                  PCMAliasBlockFile :: String -> String -> Int -> Int -> Limits -> BlockFile
PCMAliasBlockFile {
                     summaryFile_ :: String
summaryFile_ = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"e%05x.auf" Int
n,
                     aliasFile_ :: String
aliasFile_ = String
path,
                     aliasStart_ :: Int
aliasStart_ = Int
start,
                     aliasChannel_ :: Int
aliasChannel_ = Int
channel,
                     limits_ :: Limits
limits_ = Limits
Summary.defltLimits
                  }
            }) ([Int] -> ReaderT String (StateT State m) [Block])
-> [Int] -> ReaderT String (StateT State m) [Block]
forall a b. (a -> b) -> a -> b
$
   (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
totalSize) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
   (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
blockSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0

pcmAliasSequenceFromStorableVector ::
   (MonadIO m) =>
   Int -> FilePath -> Int -> SVL.Vector Float -> Summary.Monad m Sequence
pcmAliasSequenceFromStorableVector :: Int -> String -> Int -> Vector Float -> Monad m Sequence
pcmAliasSequenceFromStorableVector Int
blockSize String
aliasFile Int
channel =
   ([Block] -> Sequence)
-> ReaderT String (StateT State m) [Block] -> Monad m Sequence
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> [Block] -> Sequence
sequenceFromBlocksSize Int
blockSize) (ReaderT String (StateT State m) [Block] -> Monad m Sequence)
-> (Vector Float -> ReaderT String (StateT State m) [Block])
-> Vector Float
-> Monad m Sequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((Int, T) -> ReaderT String (StateT State m) Block)
-> [(Int, T)] -> ReaderT String (StateT State m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> T -> ReaderT String (StateT State m) Block)
-> (Int, T) -> ReaderT String (StateT State m) Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> T -> ReaderT String (StateT State m) Block)
 -> (Int, T) -> ReaderT String (StateT State m) Block)
-> (Int -> T -> ReaderT String (StateT State m) Block)
-> (Int, T)
-> ReaderT String (StateT State m) Block
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> T -> ReaderT String (StateT State m) Block
forall (m :: * -> *).
MonadIO m =>
String -> Int -> Int -> T -> Monad m Block
storeSummary String
aliasFile Int
channel) ([(Int, T)] -> ReaderT String (StateT State m) [Block])
-> (Vector Float -> [(Int, T)])
-> Vector Float
-> ReaderT String (StateT State m) [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [T] -> [(Int, T)]
Summary.attachStarts ([T] -> [(Int, T)])
-> (Vector Float -> [T]) -> Vector Float -> [(Int, T)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Int -> Vector Float -> [T]
Summary.sequenceFromStorableVector Int
blockSize

pcmAliasSequenceFromSummary ::
   (MonadIO m) =>
   FilePath -> Int -> [Summary.T] -> Summary.Monad m Sequence
pcmAliasSequenceFromSummary :: String -> Int -> [T] -> Monad m Sequence
pcmAliasSequenceFromSummary String
aliasFile Int
channel =
   ([Block] -> Sequence)
-> ReaderT String (StateT State m) [Block] -> Monad m Sequence
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Block] -> Sequence
sequenceFromBlocks (ReaderT String (StateT State m) [Block] -> Monad m Sequence)
-> ([T] -> ReaderT String (StateT State m) [Block])
-> [T]
-> Monad m Sequence
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ((Int, T) -> ReaderT String (StateT State m) Block)
-> [(Int, T)] -> ReaderT String (StateT State m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> T -> ReaderT String (StateT State m) Block)
-> (Int, T) -> ReaderT String (StateT State m) Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> T -> ReaderT String (StateT State m) Block)
 -> (Int, T) -> ReaderT String (StateT State m) Block)
-> (Int -> T -> ReaderT String (StateT State m) Block)
-> (Int, T)
-> ReaderT String (StateT State m) Block
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> T -> ReaderT String (StateT State m) Block
forall (m :: * -> *).
MonadIO m =>
String -> Int -> Int -> T -> Monad m Block
storeSummary String
aliasFile Int
channel) ([(Int, T)] -> ReaderT String (StateT State m) [Block])
-> ([T] -> [(Int, T)])
-> [T]
-> ReaderT String (StateT State m) [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [T] -> [(Int, T)]
Summary.attachStarts


{- |
This type lets you specify how to order blocks of multi-channel sounds.
Both orders always work but Haskell's garbage collector works best,
if the order matches the order of the data production.
-}
data BlockOrder =
     Serial
       {- ^ All blocks of a channel are stored adjacently. -}
   | Interleaved
       {- ^ Blocks of channels are interleaved. -}
   deriving (BlockOrder -> BlockOrder -> Bool
(BlockOrder -> BlockOrder -> Bool)
-> (BlockOrder -> BlockOrder -> Bool) -> Eq BlockOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockOrder -> BlockOrder -> Bool
$c/= :: BlockOrder -> BlockOrder -> Bool
== :: BlockOrder -> BlockOrder -> Bool
$c== :: BlockOrder -> BlockOrder -> Bool
Eq, Eq BlockOrder
Eq BlockOrder
-> (BlockOrder -> BlockOrder -> Ordering)
-> (BlockOrder -> BlockOrder -> Bool)
-> (BlockOrder -> BlockOrder -> Bool)
-> (BlockOrder -> BlockOrder -> Bool)
-> (BlockOrder -> BlockOrder -> Bool)
-> (BlockOrder -> BlockOrder -> BlockOrder)
-> (BlockOrder -> BlockOrder -> BlockOrder)
-> Ord BlockOrder
BlockOrder -> BlockOrder -> Bool
BlockOrder -> BlockOrder -> Ordering
BlockOrder -> BlockOrder -> BlockOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockOrder -> BlockOrder -> BlockOrder
$cmin :: BlockOrder -> BlockOrder -> BlockOrder
max :: BlockOrder -> BlockOrder -> BlockOrder
$cmax :: BlockOrder -> BlockOrder -> BlockOrder
>= :: BlockOrder -> BlockOrder -> Bool
$c>= :: BlockOrder -> BlockOrder -> Bool
> :: BlockOrder -> BlockOrder -> Bool
$c> :: BlockOrder -> BlockOrder -> Bool
<= :: BlockOrder -> BlockOrder -> Bool
$c<= :: BlockOrder -> BlockOrder -> Bool
< :: BlockOrder -> BlockOrder -> Bool
$c< :: BlockOrder -> BlockOrder -> Bool
compare :: BlockOrder -> BlockOrder -> Ordering
$ccompare :: BlockOrder -> BlockOrder -> Ordering
$cp1Ord :: Eq BlockOrder
Ord, Int -> BlockOrder -> ShowS
[BlockOrder] -> ShowS
BlockOrder -> String
(Int -> BlockOrder -> ShowS)
-> (BlockOrder -> String)
-> ([BlockOrder] -> ShowS)
-> Show BlockOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockOrder] -> ShowS
$cshowList :: [BlockOrder] -> ShowS
show :: BlockOrder -> String
$cshow :: BlockOrder -> String
showsPrec :: Int -> BlockOrder -> ShowS
$cshowsPrec :: Int -> BlockOrder -> ShowS
Show, Int -> BlockOrder
BlockOrder -> Int
BlockOrder -> [BlockOrder]
BlockOrder -> BlockOrder
BlockOrder -> BlockOrder -> [BlockOrder]
BlockOrder -> BlockOrder -> BlockOrder -> [BlockOrder]
(BlockOrder -> BlockOrder)
-> (BlockOrder -> BlockOrder)
-> (Int -> BlockOrder)
-> (BlockOrder -> Int)
-> (BlockOrder -> [BlockOrder])
-> (BlockOrder -> BlockOrder -> [BlockOrder])
-> (BlockOrder -> BlockOrder -> [BlockOrder])
-> (BlockOrder -> BlockOrder -> BlockOrder -> [BlockOrder])
-> Enum BlockOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlockOrder -> BlockOrder -> BlockOrder -> [BlockOrder]
$cenumFromThenTo :: BlockOrder -> BlockOrder -> BlockOrder -> [BlockOrder]
enumFromTo :: BlockOrder -> BlockOrder -> [BlockOrder]
$cenumFromTo :: BlockOrder -> BlockOrder -> [BlockOrder]
enumFromThen :: BlockOrder -> BlockOrder -> [BlockOrder]
$cenumFromThen :: BlockOrder -> BlockOrder -> [BlockOrder]
enumFrom :: BlockOrder -> [BlockOrder]
$cenumFrom :: BlockOrder -> [BlockOrder]
fromEnum :: BlockOrder -> Int
$cfromEnum :: BlockOrder -> Int
toEnum :: Int -> BlockOrder
$ctoEnum :: Int -> BlockOrder
pred :: BlockOrder -> BlockOrder
$cpred :: BlockOrder -> BlockOrder
succ :: BlockOrder -> BlockOrder
$csucc :: BlockOrder -> BlockOrder
Enum, BlockOrder
BlockOrder -> BlockOrder -> Bounded BlockOrder
forall a. a -> a -> Bounded a
maxBound :: BlockOrder
$cmaxBound :: BlockOrder
minBound :: BlockOrder
$cminBound :: BlockOrder
Bounded)


{- |
It is an unchecked error if StorableVectors have different lengths.
-}
pcmAliasSequencesFromStorableVectorChannels ::
   (MonadIO m) =>
   BlockOrder ->
   Int -> FilePath -> [SVL.Vector Float] -> Summary.Monad m [Sequence]
pcmAliasSequencesFromStorableVectorChannels :: BlockOrder -> Int -> String -> [Vector Float] -> Monad m [Sequence]
pcmAliasSequencesFromStorableVectorChannels BlockOrder
order Int
blockSize String
aliasFile =
   ([[Block]] -> [Sequence])
-> ReaderT String (StateT State m) [[Block]] -> Monad m [Sequence]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([Block] -> Sequence) -> [[Block]] -> [Sequence]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Block] -> Sequence
sequenceFromBlocksSize Int
blockSize)) (ReaderT String (StateT State m) [[Block]] -> Monad m [Sequence])
-> ([Vector Float] -> ReaderT String (StateT State m) [[Block]])
-> [Vector Float]
-> Monad m [Sequence]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   BlockOrder
-> String -> [[T]] -> ReaderT String (StateT State m) [[Block]]
forall (m :: * -> *).
MonadIO m =>
BlockOrder -> String -> [[T]] -> Monad m [[Block]]
blocksFromChannelSummaries BlockOrder
order String
aliasFile ([[T]] -> ReaderT String (StateT State m) [[Block]])
-> ([Vector Float] -> [[T]])
-> [Vector Float]
-> ReaderT String (StateT State m) [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Vector Float -> [T]) -> [Vector Float] -> [[T]]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Vector Float -> [T]
Summary.sequenceFromStorableVector Int
blockSize)


pcmAliasSequencesFromChannelSummaries ::
   (MonadIO m) =>
   BlockOrder -> FilePath -> [[Summary.T]] -> Summary.Monad m [Sequence]
pcmAliasSequencesFromChannelSummaries :: BlockOrder -> String -> [[T]] -> Monad m [Sequence]
pcmAliasSequencesFromChannelSummaries BlockOrder
order String
aliasFile =
   ([[Block]] -> [Sequence])
-> ReaderT String (StateT State m) [[Block]] -> Monad m [Sequence]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (([Block] -> Sequence) -> [[Block]] -> [Sequence]
forall a b. (a -> b) -> [a] -> [b]
map [Block] -> Sequence
sequenceFromBlocks) (ReaderT String (StateT State m) [[Block]] -> Monad m [Sequence])
-> ([[T]] -> ReaderT String (StateT State m) [[Block]])
-> [[T]]
-> Monad m [Sequence]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   BlockOrder
-> String -> [[T]] -> ReaderT String (StateT State m) [[Block]]
forall (m :: * -> *).
MonadIO m =>
BlockOrder -> String -> [[T]] -> Monad m [[Block]]
blocksFromChannelSummaries BlockOrder
order String
aliasFile

blocksFromChannelSummaries ::
   (MonadIO m) =>
   BlockOrder -> FilePath -> [[Summary.T]] -> Summary.Monad m [[Block]]
blocksFromChannelSummaries :: BlockOrder -> String -> [[T]] -> Monad m [[Block]]
blocksFromChannelSummaries BlockOrder
order String
aliasFile =
   let applyOrder :: ([[a]] -> m [[a]]) -> [[a]] -> m [[a]]
applyOrder [[a]] -> m [[a]]
f =
         case BlockOrder
order of
            BlockOrder
Serial -> [[a]] -> m [[a]]
f
            BlockOrder
Interleaved -> ([[a]] -> [[a]]) -> m [[a]] -> m [[a]]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
List.transpose (m [[a]] -> m [[a]]) -> ([[a]] -> m [[a]]) -> [[a]] -> m [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> m [[a]]
f ([[a]] -> m [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> m [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
List.transpose
   in  ([[(Int, (Int, T))]] -> Monad m [[Block]])
-> [[(Int, (Int, T))]] -> Monad m [[Block]]
forall (m :: * -> *) a a.
Monad m =>
([[a]] -> m [[a]]) -> [[a]] -> m [[a]]
applyOrder
         (([(Int, (Int, T))] -> ReaderT String (StateT State m) [Block])
-> [[(Int, (Int, T))]] -> Monad m [[Block]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
            (((Int, (Int, T)) -> ReaderT String (StateT State m) Block)
-> [(Int, (Int, T))] -> ReaderT String (StateT State m) [Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
               (\(Int
channel, (Int, T)
startBlock) ->
                  (Int -> T -> ReaderT String (StateT State m) Block)
-> (Int, T) -> ReaderT String (StateT State m) Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Int -> Int -> T -> ReaderT String (StateT State m) Block
forall (m :: * -> *).
MonadIO m =>
String -> Int -> Int -> T -> Monad m Block
storeSummary String
aliasFile Int
channel) (Int, T)
startBlock))) ([[(Int, (Int, T))]] -> Monad m [[Block]])
-> ([[T]] -> [[(Int, (Int, T))]]) -> [[T]] -> Monad m [[Block]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       (Int -> [(Int, T)] -> [(Int, (Int, T))])
-> [Int] -> [[(Int, T)]] -> [[(Int, (Int, T))]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
channel -> ((Int, T) -> (Int, (Int, T))) -> [(Int, T)] -> [(Int, (Int, T))]
forall a b. (a -> b) -> [a] -> [b]
map ((,) Int
channel)) ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) Int
0) ([[(Int, T)]] -> [[(Int, (Int, T))]])
-> ([[T]] -> [[(Int, T)]]) -> [[T]] -> [[(Int, (Int, T))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       ([T] -> [(Int, T)]) -> [[T]] -> [[(Int, T)]]
forall a b. (a -> b) -> [a] -> [b]
map [T] -> [(Int, T)]
Summary.attachStarts


sequenceFromBlocks :: [Block] -> Sequence
sequenceFromBlocks :: [Block] -> Sequence
sequenceFromBlocks [Block]
bs =
   let lens :: [Int]
lens = (Block -> Int) -> [Block] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Int
blockLength_ [Block]
bs
   in  Sequence :: Int -> SampleFormat -> Int -> [Block] -> Sequence
Sequence {
          maxSamples_ :: Int
maxSamples_ = T [] Int -> Int
forall a (f :: * -> *). (Ord a, Foldable f) => T f a -> a
NonEmpty.maximum (T [] Int -> Int) -> T [] Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
1024 Int -> [Int] -> T [] Int
forall a (f :: * -> *). a -> f a -> T f a
!: [Int]
lens,
          numSamples_ :: Int
numSamples_ = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
lens,
          sampleFormat_ :: SampleFormat
sampleFormat_ = SampleFormat
FloatSample,
          blocks_ :: [Block]
blocks_ = [Block]
bs
       }

sequenceFromBlocksSize :: Int -> [Block] -> Sequence
sequenceFromBlocksSize :: Int -> [Block] -> Sequence
sequenceFromBlocksSize Int
blockSize [Block]
bs =
   Sequence :: Int -> SampleFormat -> Int -> [Block] -> Sequence
Sequence {
      maxSamples_ :: Int
maxSamples_ = Int
blockSize,
      numSamples_ :: Int
numSamples_ = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Block -> Int) -> [Block] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Int
blockLength_ [Block]
bs,
      sampleFormat_ :: SampleFormat
sampleFormat_ = SampleFormat
FloatSample,
      blocks_ :: [Block]
blocks_ = [Block]
bs
   }


storeSummary ::
   MonadIO m =>
   FilePath -> Int -> Int -> Summary.T -> Summary.Monad m Block
storeSummary :: String -> Int -> Int -> T -> Monad m Block
storeSummary String
aliasFile Int
channel Int
start
   (Summary.Cons {
      length_ :: T -> Int
Summary.length_ = Int
len, limits_ :: T -> Limits
Summary.limits_ = Limits
limits,
      content_ :: T -> Vector Limits
Summary.content_ = Vector Limits
cont}) = do
   (Summary.State Int
n) <- Monad m State
forall (m :: * -> *). Monad m => Monad m State
Summary.reserve
   String
summaryDir <- ReaderT String (StateT State m) String
forall (m :: * -> *) r. Monad m => ReaderT r m r
MR.ask
   let fileName :: String
fileName = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"e%07x.auf" Int
n
   let dirName :: String
dirName =
         case ShowS -> (String, String) -> (String, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
2) ((String, String) -> (String, String))
-> (String, String) -> (String, String)
forall a b. (a -> b) -> a -> b
$ Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 String
fileName of
            (String
e, String
d) -> String
summaryDir String -> ShowS
</> String
e String -> ShowS
</> Char
'd'Char -> ShowS
forall a. a -> [a] -> [a]
:String
d
   IO () -> ReaderT String (StateT State m) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT String (StateT State m) ())
-> IO () -> ReaderT String (StateT State m) ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dirName
      String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile (String
dirName String -> ShowS
</> String
fileName) IOMode
IO.WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
         Handle -> ByteString -> IO ()
BS.hPut Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
"AudacityBlockFile112"
         Handle -> Vector Limits -> IO ()
forall a. Storable a => Handle -> Vector a -> IO ()
SVL.hPut Handle
h Vector Limits
cont
   Block -> Monad m Block
forall (m :: * -> *) a. Monad m => a -> m a
return (Block -> Monad m Block) -> Block -> Monad m Block
forall a b. (a -> b) -> a -> b
$
      Block :: Int -> Int -> BlockFile -> Block
Block {
         blockStart_ :: Int
blockStart_ = Int
start,
         blockLength_ :: Int
blockLength_ = Int
len,
         blockFile_ :: BlockFile
blockFile_ =
            PCMAliasBlockFile :: String -> String -> Int -> Int -> Limits -> BlockFile
PCMAliasBlockFile {
               summaryFile_ :: String
summaryFile_ = String
fileName,
               aliasFile_ :: String
aliasFile_ = String
aliasFile,
               aliasStart_ :: Int
aliasStart_ = Int
start,
               aliasChannel_ :: Int
aliasChannel_ = Int
channel,
               limits_ :: Limits
limits_ = Limits
limits
            }
      }