HarmTrace-Base-1.5.3.1: Parsing and unambiguously representing musical chords.

Copyright(c) 2012--2016, Chordify BV
LicenseLGPL-3
Maintainerhaskelldevelopers@chordify.net
Stabilityexperimental
Portabilitynon-portable
Safe HaskellSafe
LanguageHaskell2010

HarmTrace.Base.Time

Contents

Description

Summary: A set of types and classes for representing musical time, mainly (but not necessarily) in the context of recognising chords from an arbitrary audio source.

Synopsis

Representing musical time

type Timed a = Timed' Float a Source #

a shorthand for a Timed' datatype that uses Float precision (also for backwards competibility)

type DTimed a = Timed' Double a Source #

a shorthand for Double precision

data Timed' t a Source #

A datatype that wraps around an (musical) datatype, adding information about the musical time to this datatype. Musical time is stored as a list of BeatTime time stamps that can optionally be augmented with information about the Beat position of the particular time stamp inside the bar.

Constructors

Timed 

Fields

Instances

Functor (Timed' t) Source # 

Methods

fmap :: (a -> b) -> Timed' t a -> Timed' t b #

(<$) :: a -> Timed' t b -> Timed' t a #

(Eq t, Eq a) => Eq (Timed' t a) Source # 

Methods

(==) :: Timed' t a -> Timed' t a -> Bool #

(/=) :: Timed' t a -> Timed' t a -> Bool #

(Fractional t, Show t, Show a) => Show (Timed' t a) Source # 

Methods

showsPrec :: Int -> Timed' t a -> ShowS #

show :: Timed' t a -> String #

showList :: [Timed' t a] -> ShowS #

Generic (Timed' t a) Source # 

Associated Types

type Rep (Timed' t a) :: * -> * #

Methods

from :: Timed' t a -> Rep (Timed' t a) x #

to :: Rep (Timed' t a) x -> Timed' t a #

type Rep (Timed' t a) Source # 
type Rep (Timed' t a) = D1 (MetaData "Timed'" "HarmTrace.Base.Time" "HarmTrace-Base-1.5.3.1-3qA2fvFtftT46JVsdcg0NC" False) (C1 (MetaCons "Timed" PrefixI True) ((:*:) (S1 (MetaSel (Just Symbol "getData") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a)) (S1 (MetaSel (Just Symbol "getTimeStamps") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 [BeatTime t]))))

data Beat Source #

For now, we fix the number of available beats to four, because this is also hard-coded into the bar and beat-tracker.

Constructors

One 
Two 
Three 
Four 
NoBeat 

Instances

Enum Beat Source # 

Methods

succ :: Beat -> Beat #

pred :: Beat -> Beat #

toEnum :: Int -> Beat #

fromEnum :: Beat -> Int #

enumFrom :: Beat -> [Beat] #

enumFromThen :: Beat -> Beat -> [Beat] #

enumFromTo :: Beat -> Beat -> [Beat] #

enumFromThenTo :: Beat -> Beat -> Beat -> [Beat] #

Eq Beat Source # 

Methods

(==) :: Beat -> Beat -> Bool #

(/=) :: Beat -> Beat -> Bool #

Ord Beat Source # 

Methods

compare :: Beat -> Beat -> Ordering #

(<) :: Beat -> Beat -> Bool #

(<=) :: Beat -> Beat -> Bool #

(>) :: Beat -> Beat -> Bool #

(>=) :: Beat -> Beat -> Bool #

max :: Beat -> Beat -> Beat #

min :: Beat -> Beat -> Beat #

Show Beat Source # 

Methods

showsPrec :: Int -> Beat -> ShowS #

show :: Beat -> String #

showList :: [Beat] -> ShowS #

Generic Beat Source # 

Associated Types

type Rep Beat :: * -> * #

Methods

from :: Beat -> Rep Beat x #

to :: Rep Beat x -> Beat #

type Rep Beat Source # 
type Rep Beat = D1 (MetaData "Beat" "HarmTrace.Base.Time" "HarmTrace-Base-1.5.3.1-3qA2fvFtftT46JVsdcg0NC" False) ((:+:) ((:+:) (C1 (MetaCons "One" PrefixI False) U1) (C1 (MetaCons "Two" PrefixI False) U1)) ((:+:) (C1 (MetaCons "Three" PrefixI False) U1) ((:+:) (C1 (MetaCons "Four" PrefixI False) U1) (C1 (MetaCons "NoBeat" PrefixI False) U1))))

data BeatTime a Source #

Represents a musical time stamp, which is a NumData possibly augmented with a Beat denoting the position of the time stamp within a bar.

Constructors

BeatTime a Beat 
Time a 

Instances

Functor BeatTime Source # 

Methods

fmap :: (a -> b) -> BeatTime a -> BeatTime b #

(<$) :: a -> BeatTime b -> BeatTime a #

Eq a => Eq (BeatTime a) Source # 

Methods

(==) :: BeatTime a -> BeatTime a -> Bool #

(/=) :: BeatTime a -> BeatTime a -> Bool #

(Ord t, Fractional t) => Ord (BeatTime t) Source # 

Methods

compare :: BeatTime t -> BeatTime t -> Ordering #

(<) :: BeatTime t -> BeatTime t -> Bool #

(<=) :: BeatTime t -> BeatTime t -> Bool #

(>) :: BeatTime t -> BeatTime t -> Bool #

(>=) :: BeatTime t -> BeatTime t -> Bool #

max :: BeatTime t -> BeatTime t -> BeatTime t #

min :: BeatTime t -> BeatTime t -> BeatTime t #

(Show t, Fractional t) => Show (BeatTime t) Source # 

Methods

showsPrec :: Int -> BeatTime t -> ShowS #

show :: BeatTime t -> String #

showList :: [BeatTime t] -> ShowS #

Generic (BeatTime a) Source # 

Associated Types

type Rep (BeatTime a) :: * -> * #

Methods

from :: BeatTime a -> Rep (BeatTime a) x #

to :: Rep (BeatTime a) x -> BeatTime a #

type Rep (BeatTime a) Source # 

data MeterKind Source #

Having a high-level representation of a musical meter: Duple is counted in two and Triple in three.

Constructors

Duple 
Triple 

Instances

Eq MeterKind Source # 
Ord MeterKind Source # 
Show MeterKind Source # 
Generic MeterKind Source # 

Associated Types

type Rep MeterKind :: * -> * #

type Rep MeterKind Source # 
type Rep MeterKind = D1 (MetaData "MeterKind" "HarmTrace.Base.Time" "HarmTrace-Base-1.5.3.1-3qA2fvFtftT46JVsdcg0NC" False) ((:+:) (C1 (MetaCons "Duple" PrefixI False) U1) (C1 (MetaCons "Triple" PrefixI False) U1))

Functions

Data access

timed :: Fractional t => a -> t -> t -> Timed' t a Source #

alternative Timed constructor

timedBT :: Fractional t => a -> BeatTime t -> BeatTime t -> Timed' t a Source #

alternative Timed constructor

onBeatTime :: Fractional t => Timed' t a -> BeatTime t Source #

Returns the start BeatTime

offBeatTime :: Fractional t => Timed' t a -> BeatTime t Source #

Returns the offset time stamp

onBeat :: Timed a -> Beat Source #

Returns the start Beat

offBeat :: Timed a -> Beat Source #

Returns the offset time stamp

onset :: Fractional t => Timed' t a -> t Source #

Returns the onset time stamp

offset :: Fractional t => Timed' t a -> t Source #

Returns the offset time stamp

duration :: Fractional t => Timed' t a -> t Source #

Returns the duration of Timed

setData :: Timed a -> b -> Timed b Source #

wraps a datatype in Timed

getEndTime :: Fractional t => [Timed' t a] -> t Source #

Given a list of Timed values, returns the end time of the latest element in the list.

Type conversion and other utilities

mergeTimed :: Eq a => [Timed a] -> [Timed a] Source #

merges consecutive Timed values that store the same element (using ('(==)'). For example:

>>> mergeTimed [timed "c" 0 1, timed "c" 1 2, timed "d" 3 4, timed "d" 4 5, timed "e" 5 6]
>>> [Timed {getData = "c", getTimeStamps = [(0.0),(1.0),(2.0)]}
>>> ,Timed {getData = "d", getTimeStamps = [(3.0),(4.0),(5.0)]}
>>> ,Timed {getData = "e", getTimeStamps = [(5.0),(6.0)]}]

mergeTimedWith :: forall a. Eq a => (a -> a -> Bool) -> [Timed a] -> [Timed a] Source #

Does exactly what mergeTimed does, but allows for a custom equality function

expandTimed :: [Timed a] -> [Timed a] Source #

the inverse of mergeTimed, expanding the list Timed elements to all timestamps stored in the getTimeStamps list. N.B.

>>> expandTimed (mergeTimed x) = x :: [Timed a]

also,

>>> (expandTimed cs) = cs

and,

>>> mergeTimed (mergeTimed (mergeTimed cs)) = (mergeTimed cs)

hold. This has been tested on the first tranche of 649 Billboard songs.

concatTimed :: a -> Timed a -> Timed a -> Timed a Source #

concatenates the BeatTime timestamps of two Timeds and creates a new Timed that stores the first argument. N.B. this function uses timeComp to allow for very small timing deviations

splitTimed :: (Show a, Ord t, Show t, Fractional t) => Timed' t a -> t -> (Timed' t a, Timed' t a) Source #

Splits a Timed in two Timeds at the specified position. If the position is out of range, an error is thrown.

>>> splitTimed (Timed "x" [Time 2, Time 5]) 4
>>> ( Timed {getData = "x", getTimeStamps = [(2.0),(4.0)]}
>>> , Timed {getData = "x", getTimeStamps = [(4.0),(5.0)]} )

setMeterKind :: MeterKind -> [Timed a] -> [Timed a] Source #

Changes the internal MeterKind of a Timed sequence. We assume that meter changes do nog occur.

updateBeats :: MeterKind -> Beat -> [Timed a] -> [Timed a] Source #

applies updateBeat to a list. updateBeats requires a MeterKind and a starting Beat.

>>> updateBeats Triple Three [ timedBT "a" (BeatTime 0 Three) (BeatTime 1 Four)
>>> , timedBT "a" (BeatTime 1 Four) (BeatTime 2 One)
>>> , Timed "a" [ BeatTime 2 One, BeatTime 3 Two
>>> , BeatTime 4 Three, BeatTime 5 Four]]
>>> [Timed {getData = "a", getTimeStamps = [(0.0, 3),(1.0, 1)]}
>>> ,Timed {getData = "a", getTimeStamps = [(1.0, 1),(2.0, 2)]}
>>> ,Timed {getData = "a", getTimeStamps = [(2.0, 2),(3.0, 3),(4.0, 1),(5.0, 2)]}]

updateBeat :: MeterKind -> Beat -> Timed a -> Timed a Source #

Update the Beats in Timed data given a MeterKind and a starting beat:

>>> updateBeat Triple Two (Timed "c" [ BeatTime 0 Three
>>> , BeatTime 1 Four
>>> , BeatTime 2 One])
>>> Timed {getData = "c", getTimeStamps = [(0.0, 2),(1.0, 3),(2.0, 1)]}

splitPickup :: [Timed a] -> ([Timed a], [Timed a]) Source #

N.B. calls expandTimed before splitting

nextBeat :: MeterKind -> Beat -> Beat Source #

returns the next beat, e.g. nextBeat Two = Three . Following the (current) definition of Beat, we still assume 4/4, in the future this function should also have the meter as an argument. N.B. nextBeat Four = One

prevBeat :: MeterKind -> Beat -> Beat Source #

returns the previous Beat, similar to prevBeat.

lastBeat :: MeterKind -> Beat Source #

returns the last Beat of the MeterKind

>>> lastBeat Duple
>>> Four

updBeat :: Fractional t => (Beat -> Beat) -> BeatTime t -> BeatTime t Source #

updates a Beat in a BeatTime

updTime :: Fractional t => (t -> t) -> BeatTime t -> BeatTime t Source #

updates a timestamp in a BeatTime

updateTimeStamp :: Fractional t => ([BeatTime t] -> [BeatTime t]) -> Timed' t a -> Timed' t a Source #

updates the timestamps in a Timed datatype

dropTimed :: [Timed a] -> [a] Source #

drops the time (with or without Beat) information of a list Timed data structure

timeStamp :: Fractional t => BeatTime t -> t Source #

Returns the NumData timestamp, given a BeatTime

timeComp :: (Ord t, Fractional t) => t -> t -> Ordering Source #

compares to NumData timestamps taking a rounding error roundingError into account.

roundingError :: Fractional t => t Source #

When reducing and expanding Timed types there might be rounding errors in the floating point time stamps. The roundingError parameter sets the acceptable rounding error that is used in the comparison of time stamps (e.g. see timeComp)

beat :: BeatTime t -> Beat Source #

Returns the NumData timestamp, given a BeatTime

pprint :: Show a => Timed a -> String Source #

Pretty prints a single Timed

prettyPrint :: Show a => [Timed a] -> String Source #

Pretty prints a list of Timeds, one per line