diff --git a/music-parts.cabal b/music-parts.cabal --- a/music-parts.cabal +++ b/music-parts.cabal @@ -1,6 +1,6 @@ name: music-parts -version: 1.7.2 +version: 1.8 author: Hans Hoglund maintainer: Hans Hoglund license: BSD3 @@ -21,20 +21,22 @@ location: git://github.com/music-suite/music-parts.git library - build-depends: base >= 4 && < 5, - aeson >= 0.7.0.6 && < 1, - lens >= 4.3.3 && < 4.4, + build-depends: base >= 4 && < 5, + containers >= 0.5.5.1 && < 1, + aeson >= 0.7.0.6 && < 1, + lens >= 4.6 && < 4.7, semigroups >= 0.13.0.1 && < 1, - semigroupoids, - data-default, - adjunctions >= 4.1 && < 5, - roman-numerals, - music-pitch == 1.7.2 + data-default >= 0.5.3 && < 1, + adjunctions >= 4.1 && < 5, + roman-numerals >= 0.5.1.4 && < 1, + music-pitch == 1.8, + music-dynamics == 1.8 exposed-modules: Data.Semigroup.Option.Instances Music.Parts Music.Parts.Basic + Music.Parts.Voices -- -- TODO choral voicings etc -- -- TODO use single type or many? How to do "subtyping" @@ -53,14 +55,16 @@ -- Music.Parts.Woodwind -- Music.Parts.Brass -- Music.Parts.Percussion + -- Music.Parts.Instrument.Keyboard -- Music.Parts.Rhythm -- Music.Parts.Other Music.Parts.Instrument - -- Music.Parts.Instrument.Strings - -- Music.Parts.Instrument.Woodwind - -- Music.Parts.Instrument.Brass - -- Music.Parts.Instrument.Percussion + Music.Parts.Instrument.Strings + Music.Parts.Instrument.Woodwind + Music.Parts.Instrument.Brass + Music.Parts.Instrument.Percussion + Music.Parts.Instrument.Keyboard -- Music.Parts.Instrument.Rhythm -- Music.Parts.Instrument.Other diff --git a/src/Data/Semigroup/Option/Instances.hs b/src/Data/Semigroup/Option/Instances.hs --- a/src/Data/Semigroup/Option/Instances.hs +++ b/src/Data/Semigroup/Option/Instances.hs @@ -13,6 +13,7 @@ import Text.Numeral.Roman (toRoman) -- TODO move +-- TODO toInteger/toRational/fromEnum are unsafe instance Num a => Num (Option a) where (+) = liftA2 (+) @@ -44,6 +45,3 @@ toInteger = toInteger . get where get = (head.toListOf traverse) instance Real a => Real (First a) where toRational = toRational . get where get = (head.toListOf traverse) --- instance Enum a => Enum (First a) where - -- toEnum = toEnum . get where get = (head.toListOf traverse) - -- fromEnum = pure . fromEnum diff --git a/src/Music/Parts.hs b/src/Music/Parts.hs --- a/src/Music/Parts.hs +++ b/src/Music/Parts.hs @@ -592,11 +592,11 @@ isMonophonic :: Score a -> Bool -- | Fails for polyphonic scores. - scoreToVoice :: Score a -> Voice (Maybe a) + s_oreToVoice :: Score a -> Voice (Maybe a) A polyphonic score contains several voices, i.e. - scoreToVoices :: Score a -> [Voice (Maybe a)] + s_oreToVoices :: Score a -> [Voice (Maybe a)] A part is any type a that satisfies (Ord a, Show a). diff --git a/src/Music/Parts/Instrument.hs b/src/Music/Parts/Instrument.hs --- a/src/Music/Parts/Instrument.hs +++ b/src/Music/Parts/Instrument.hs @@ -15,13 +15,22 @@ -- ------------------------------------------------------------------------------------- -module Music.Parts.Instrument -( -Instrument(..), --- TODO hide impl -) -where +module Music.Parts.Instrument ( + Instrument(..), + -- TODO hide impl + allowedClefs, + playableRange, + comfortableRange, + playableDynamics, + -- * Name etc + instrumentName, + fullName, + shortName, + transposition, + transpositionString + ) where + import Control.Applicative import Control.Lens (toListOf) import Data.Default @@ -30,8 +39,12 @@ import Data.Maybe import Data.Semigroup import Data.Semigroup.Option.Instances +import Data.Set (Set) import Data.Traversable (traverse) import Data.Typeable +import Music.Dynamics (Dynamics) +import Music.Pitch (Ambitus, Clef) +import Music.Pitch.Common (Interval, Pitch) import Text.Numeral.Roman (toRoman) -- | An 'Instrument' represents the set of all instruments of a given type. @@ -290,4 +303,34 @@ (80, "Mute Triangle"), (81, "Open Triangle") ] - + + + +allowedClefs :: Instrument -> Set Clef +allowedClefs = error "No allowedClefs" + +playableRange :: Instrument -> Ambitus Pitch +playableRange = error "No playableRange" + +comfortableRange :: Instrument -> Ambitus Pitch +comfortableRange = error "No comfortableRange" + +playableDynamics :: Instrument -> Pitch -> Dynamics +playableDynamics = error "No playableDynamics" + +instrumentName :: Instrument -> String +instrumentName = error "No name" + +fullName :: Instrument -> String +fullName = error "No fullName" + +shortName :: Instrument -> String +shortName = error "No shortName" + +-- sounding .-. written, i.e. -P5 for clarinet +transposition :: Instrument -> Interval +transposition = error "No transposition" + +transpositionString :: Instrument -> String +transpositionString = error "No transpositionString" + diff --git a/src/Music/Parts/Instrument/Brass.hs b/src/Music/Parts/Instrument/Brass.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Instrument/Brass.hs @@ -0,0 +1,17 @@ + +module Music.Parts.Instrument.Brass ( + BrassInstrument, + brassInstrument, + ) where + +import Control.Lens +import Music.Parts.Instrument +import Data.Set (Set) +import Music.Pitch.Common (Pitch, Interval) +import Music.Pitch (Ambitus, Clef) + +newtype BrassInstrument = BrassInstrument Instrument + +brassInstrument :: Prism' Instrument BrassInstrument +brassInstrument = undefined +-- TODO diff --git a/src/Music/Parts/Instrument/Keyboard.hs b/src/Music/Parts/Instrument/Keyboard.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Instrument/Keyboard.hs @@ -0,0 +1,17 @@ + +module Music.Parts.Instrument.Keyboard ( + KeyboardInstrument, + keyboardInstrument, + ) where + +import Control.Lens +import Music.Parts.Instrument +import Data.Set (Set) +import Music.Pitch.Common (Pitch, Interval) +import Music.Pitch (Ambitus, Clef) + +newtype KeyboardInstrument = KeyboardInstrument Instrument + +keyboardInstrument :: Prism' Instrument KeyboardInstrument +keyboardInstrument = undefined +-- TODO diff --git a/src/Music/Parts/Instrument/Percussion.hs b/src/Music/Parts/Instrument/Percussion.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Instrument/Percussion.hs @@ -0,0 +1,17 @@ + +module Music.Parts.Instrument.Percussion ( + PercussionInstrument, + percussionInstrument, + ) where + +import Control.Lens +import Music.Parts.Instrument +import Data.Set (Set) +import Music.Pitch.Common (Pitch, Interval) +import Music.Pitch (Ambitus, Clef) + +newtype PercussionInstrument = PercussionInstrument Instrument + +percussionInstrument :: Prism' Instrument PercussionInstrument +percussionInstrument = undefined +-- TODO diff --git a/src/Music/Parts/Instrument/Strings.hs b/src/Music/Parts/Instrument/Strings.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Instrument/Strings.hs @@ -0,0 +1,55 @@ + +module Music.Parts.Instrument.Strings ( + StringInstrument, + stringInstrument, + + StringTuning, + standardTuning, + allowedTunings, + + isAllowedTuning, + isStandardTuning, + isNonStandardTuning, + + HarmonicPosition, + + naturalHarmonicPositions, + ) where + +import Control.Lens +import Music.Parts.Instrument +import Data.Set (Set) +import Music.Pitch.Common (Pitch, Interval) +import Music.Pitch (Ambitus, Clef) + +newtype StringInstrument = StringInstrument Instrument + +stringInstrument :: Prism' Instrument StringInstrument +stringInstrument = undefined +-- TODO + +type StringTuning = [Pitch] + +standardTuning :: StringInstrument -> StringTuning +standardTuning = error "No standardTuning" + +-- TODO various tunings +allowedTunings :: StringInstrument -> Set StringTuning +allowedTunings = error "No allowedTunings" + + +isAllowedTuning :: StringInstrument -> StringTuning -> Bool +isAllowedTuning = error "No isAllowedTuning" + +isStandardTuning :: StringInstrument -> StringTuning -> Bool +isStandardTuning = error "No isStandardTuning" + +isNonStandardTuning :: StringInstrument -> StringTuning -> Bool +isNonStandardTuning = error "No isNonStandardTuning" + + +type HarmonicPosition = Integer + +naturalHarmonicPositions :: StringInstrument -> Set HarmonicPosition +naturalHarmonicPositions = error "No naturalHarmonicPositions" + diff --git a/src/Music/Parts/Instrument/Woodwind.hs b/src/Music/Parts/Instrument/Woodwind.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Instrument/Woodwind.hs @@ -0,0 +1,38 @@ + +module Music.Parts.Instrument.Woodwind ( + WoodwindInstrument, + woodwindInstrument, + + GlissandoRange, + Glissando, + allowedGlissandi, + effectiveGlissandi, + isAllowedGlissando, + ) where + +import Control.Lens +import Music.Parts.Instrument +import Data.Set (Set) +import Music.Pitch.Common (Pitch, Interval) +import Music.Pitch (Ambitus, Clef) + +newtype WoodwindInstrument = WoodwindInstrument Instrument + +woodwindInstrument :: Prism' Instrument WoodwindInstrument +woodwindInstrument = undefined +-- TODO + +type GlissandoRange = Ambitus Pitch +type Glissando = Ambitus Pitch + +allowedGlissandi :: Set GlissandoRange +allowedGlissandi = error "No allowedGlissandi" + +effectiveGlissandi :: Set GlissandoRange +effectiveGlissandi = error "No effectiveGlissandi" + + +isAllowedGlissando :: WoodwindInstrument -> Glissando -> Bool +isAllowedGlissando = error "No isAllowedGlissandi" + +-- TODO correspondance of range/sound/dynamic diff --git a/src/Music/Parts/Subpart.hs b/src/Music/Parts/Subpart.hs --- a/src/Music/Parts/Subpart.hs +++ b/src/Music/Parts/Subpart.hs @@ -18,6 +18,9 @@ module Music.Parts.Subpart ( Subpart(..), containsSubpart, + properlyContainsSubpart, + isSubpartOf, + isProperSubpartOf, ) where import Control.Applicative @@ -51,5 +54,18 @@ mapFR f g (x:xs) = f x : fmap g xs containsSubpart :: Subpart -> Subpart -> Bool -Subpart x `containsSubpart` Subpart y = y `Data.List.isPrefixOf` x +containsSubpart = flip isSubpartOf + +properlyContainsSubpart :: Subpart -> Subpart -> Bool +properlyContainsSubpart = flip isProperSubpartOf + +isSubpartOf :: Subpart -> Subpart -> Bool +Subpart x `isSubpartOf` Subpart y = y `Data.List.isPrefixOf` x + +x `isProperSubpartOf` y = + x `isSubpartOf` y && x /= y + + + + diff --git a/src/Music/Parts/Voices.hs b/src/Music/Parts/Voices.hs new file mode 100644 --- /dev/null +++ b/src/Music/Parts/Voices.hs @@ -0,0 +1,50 @@ + +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +------------------------------------------------------------------------------------ +-- | +-- Copyright : (c) Hans Hoglund 2012-2015 +-- +-- License : BSD-style +-- +-- Maintainer : hans@hanshoglund.se +-- Stability : experimental +-- Portability : non-portable (TF,GNTD) +-- +-- Provides basic voice types. Useful for vocal music but also for abstract +-- voice leading etc. +-- +------------------------------------------------------------------------------------- + +module Music.Parts.Voices ( + ) where + +import Control.Applicative +import Control.Lens (toListOf) +import Data.Default +import Data.Functor.Adjunction (unzipR) +import qualified Data.List +import Data.Maybe +import Data.Semigroup +import Data.Traversable (traverse) +import Data.Typeable +import Text.Numeral.Roman (toRoman) +import Data.Semigroup.Option.Instances + +-- TODO newtype... +-- Related to "bounded" and "sized" integers (i.e. Pitch.Equal) +type SATB = Int +type SSAATTBB = Int +type SMezATBarB = Int + +-- newtype BasicPart = BasicPart { getBasicPart :: Option (First Integer) } +-- deriving (Eq, Ord, Num, Integral, Real, Enum, Typeable, Semigroup, Monoid) +-- +-- instance Default BasicPart where +-- def = mempty +-- +-- instance Show BasicPart where +-- show _ = "" +--