diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) Stefan Kersten 2008 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Sound/WaveSurfer.hs b/Sound/WaveSurfer.hs new file mode 100644 --- /dev/null +++ b/Sound/WaveSurfer.hs @@ -0,0 +1,138 @@ +-- | Parse WaveSurfer files. +-- +-- WaveSurfer is an application for analysing and annotating audio files. +-- +-- +-- A WaveSurfer file consists of lines containing a label and corresponding +-- onsets and offsets in seconds: +-- +-- > onset offset label +-- +-- This library supports an extended file format, where the first label can be +-- followed by additional key-value pairs, separated by colons: +-- +-- > onset offset label key1[:value1] key2[:value2] ... +-- +module Sound.WaveSurfer ( + Time, DTime, + Label, Attribute, + Record(..), duration, + Result, + encode, decode, + interact +) where + +import Data.Binary.Put (Put, runPut, putByteString) +import Data.Maybe (mapMaybe) + +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC +import Data.ByteString.Lex.Double (readDouble) + +import Text.Delimited (Result) +import qualified Text.Delimited as DT +import Prelude hiding (interact) +import Text.Show.ByteString (putAscii, showp, unlinesP, unwordsP) +import qualified Text.Show.ByteString as ShowP + +-- | Time type. +type Time = Double + +-- | Type for time differences. +type DTime = Time + +-- | Record label. +type Label = BS.ByteString + +-- | Key-value pair. +type Attribute = (Label, Maybe Label) + +-- | Record representing a single line in the WaveSurfer file. +data Record = Record { + onset :: Time, + offset :: Time, + label :: Label, + attributes :: [Attribute] +} deriving (Eq, Show) + +-- | A file's content is a list of records. +type Content = [Record] + +-- | Return the duration of a 'Record' in seconds. +duration :: Record -> DTime +duration e = offset e - onset e + +whiteSpace :: [Char] +whiteSpace = [' ', '\t'] + +-- | Comment character. +comment :: Char +comment = '#' + +putAttribute :: Attribute -> Put +putAttribute (key, value) = do + putByteString key + case value of + Just v -> putAscii ':' >> putByteString v + Nothing -> return () + +putRecord :: Record -> Put +putRecord r = unwordsP ([t0, t1, putByteString (label r)] ++ attrs) + where + t0 = showp (onset r) + t1 = showp (offset r) + attrs = map putAttribute (attributes r) + +putContent :: Content -> Put +putContent = unlinesP . map putRecord + +-- | Encode 'Content' to a lazy 'ByteString'. +encode :: Content -> ByteString +encode = runPut . putContent + +-- | Monad instance for Either. +instance Monad (Either a) where + return = Right + x >>= f = case x of + Left a -> Left a + Right r -> f r + +-- | Decode attributes. +decodeAttributes :: DT.Record -> Result [Attribute] +decodeAttributes = return . map f + where f s = let (k, v) = BSC.break (==':') s + v' = BS.tail v + in (k, if BS.null v' then Nothing else Just v') + +-- | Decode a 'Double'. +decodeDouble :: DT.Field -> Result Double +decodeDouble s = case readDouble s of + Just (d, _) -> Right d + Nothing -> Left ("Couldn't parse Double: " ++ show s) + +-- | Decode a 'Record'. +decodeRecord :: DT.Record -> Result Record +decodeRecord (t0:t1:lbl:attrs) = do + t0' <- decodeDouble t0 + t1' <- decodeDouble t1 + attrs' <- decodeAttributes attrs + return (Record t0' t1' lbl attrs') +decodeRecord r = Left ("Couldn't parse record: " ++ show r) + +-- | Decode 'Content' from a lazy 'ByteString'. +decode :: ByteString -> Result Content +decode s = do + xs <- DT.decode whiteSpace s + mapM decodeRecord (filter f xs) + where + f [] = False + f (r:rs) = not (BSC.null r) && (BSC.head r /= comment) + +interact :: (Record -> Record) -> ByteString -> Result ByteString +interact f s = do + c <- decode s + let c' = map f c + return (encode c') diff --git a/wavesurfer.cabal b/wavesurfer.cabal new file mode 100644 --- /dev/null +++ b/wavesurfer.cabal @@ -0,0 +1,27 @@ +name: wavesurfer +version: 0.0.1 +synopsis: Parse WaveSurfer files +description: Parse WaveSurfer files +license: BSD3 +license-file: LICENSE +category: Data, Sound, Text +copyright: Copyright (c) Stefan Kersten 2008 +author: Stefan Kersten +maintainer: Stefan Kersten +stability: provisional +homepage: http://code.haskell.org/~StefanKersten/code/wavesurfer +tested-with: GHC == 6.10.1 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Sound.WaveSurfer + + build-depends: base >= 3, + binary >= 0.4, + bytestring, + bytestring-lexing, + bytestring-show, + delimited-text + + ghc-options: -O2 -funbox-strict-fields