classify-frog-0.2.3: src/Signal.hs

module Signal where

import qualified Rate

import qualified LabelChain
import qualified Sound.Audacity.LabelTrack as LabelTrack

import qualified Synthesizer.Generic.Cut as CutG
import qualified Data.StorableVector.Lazy as SVL

import Control.DeepSeq (NFData, rnf, )

import Data.Traversable (Traversable, traverse)
import Data.Foldable (Foldable, foldMap)

import Data.Int (Int32, )


data T rate body =
   Cons {
      sampleRate :: rate,
      body :: body
   }

type LabelTrack rate a = T rate (LabelTrack.T Int a)
type LabelChain rate a = T rate (LabelChain.T Int a)

type Sampled a = T Rate.Sample (SVL.Vector a)
type Sox = Sampled Int32
type SoxLabelled a = T Rate.Sample (SVL.Vector Int32, LabelChain.T Int a)


instance (Rate.C rate, NFData body) => NFData (T rate body) where
   rnf (Cons rate xs) = rnf (Rate.unpack rate, xs)

instance Functor (T rate) where
   fmap f (Cons rate xs) = Cons rate $ f xs

instance Foldable (T rate) where
   foldMap f (Cons _rate xs) = f xs

instance Traversable (T rate) where
   traverse f (Cons rate xs) = fmap (Cons rate) $ f xs


-- | more descriptive than 'fmap'
map :: (a -> b) -> T rate a -> T rate b
map = fmap

duration :: (Rate.C rate, CutG.Read signal) => T rate signal -> Double
duration (Cons rate xs) =
   fromIntegral (CutG.length xs) / Rate.unpack rate

labelRealTimes ::
   (Rate.C rate) => LabelChain rate a -> LabelChain.T Double a
labelRealTimes (Cons rate xs) = LabelChain.realTimes rate xs

labelDiscretizeTimes ::
   (Rate.C rate) =>
   rate -> LabelChain.T Double a -> LabelChain rate a
labelDiscretizeTimes rate =
   Cons rate . LabelChain.mapTime (round . (Rate.unpack rate *))

labelResample ::
   (Rate.C rate0, Rate.C rate1) =>
   rate1 -> LabelChain rate0 a -> LabelChain rate1 a
labelResample rate = labelDiscretizeTimes rate . labelRealTimes

addDiscretizedLabels ::
   (Rate.C rate) =>
   T rate a -> LabelChain.T Double b -> T rate (a, LabelChain.T Int b)
addDiscretizedLabels (Cons rate as) bs =
   Cons rate (as, body $ labelDiscretizeTimes rate bs)