music-score 1.8.1 → 1.9.0

raw patch · 50 files changed

+1006/−1390 lines, 50 filesdep +base-orphansdep ~averagedep ~bifunctorsdep ~lensPVP ok

version bump matches the API change (PVP)

Dependencies added: base-orphans

Dependency ranges changed: average, bifunctors, lens, lilypond, mtl, music-dynamics-literal, music-pitch-literal, musicxml2, parsec, transformers, transformers-compat, vector-space, vector-space-points

API changes (from Hackage documentation)

Files

• music-score.cabal +16/−20
• src/Data/AffineSpace/Point/Offsets.hs +51/−0
• src/Data/Semigroup/Instances.hs +0/−9
• src/Music/Score.hs +11/−11
• src/Music/Score/Color.hs +4/−0
• src/Music/Score/Dynamics.hs +13/−10
• src/Music/Score/Export/Backend.hs +2/−2
• src/Music/Score/Export/Lilypond.hs +1/−1
• src/Music/Score/Export/Midi.hs +0/−2
• src/Music/Score/Export/MusicXml.hs +33/−8
• src/Music/Score/Export/NoteList.hs +0/−2
• src/Music/Score/Export/SuperCollider.hs +0/−2
• src/Music/Score/Import/Midi.hs +67/−8
• src/Music/Score/Internal/Export.hs +0/−2
• src/Music/Score/Internal/Instances.hs +2/−4
• src/Music/Score/Internal/Quantize.hs +77/−18
• src/Music/Score/Meta.hs +2/−2
• src/Music/Score/Meta/Tempo.hs +1/−1
• src/Music/Score/Meta/Time.hs +4/−4
• src/Music/Score/Part.hs +15/−0
• src/Music/Score/Pitch.hs +32/−117
• src/Music/Time.hs +8/−14
• src/Music/Time/Aligned.hs +50/−21
• src/Music/Time/Behavior.hs +9/−9
• src/Music/Time/Bound.hs +10/−15
• src/Music/Time/Chord.hs +0/−208
• src/Music/Time/Duration.hs +9/−7
• src/Music/Time/Event.hs +29/−117
• src/Music/Time/Future.hs +2/−2
• src/Music/Time/Graces.hs +0/−57
• src/Music/Time/Internal/Convert.hs +3/−5
• src/Music/Time/Internal/Transform.hs +23/−25
• src/Music/Time/Internal/Util.hs +22/−18
• src/Music/Time/Juxtapose.hs +7/−28
• src/Music/Time/Meta.hs +22/−31
• src/Music/Time/Nominal.hs +0/−66
• src/Music/Time/Note.hs +101/−35
• src/Music/Time/Past.hs +10/−11
• src/Music/Time/Placed.hs +15/−28
• src/Music/Time/Position.hs +29/−33
• src/Music/Time/Reactive.hs +14/−16
• src/Music/Time/Rest.hs +1/−2
• src/Music/Time/Reverse.hs +13/−15
• src/Music/Time/Score.hs +55/−48
• src/Music/Time/Segment.hs +18/−20
• src/Music/Time/Split.hs +30/−33
• src/Music/Time/Track.hs +19/−29
• src/Music/Time/Transform.hs +10/−0
• src/Music/Time/Types.hs +33/−73
• src/Music/Time/Voice.hs +133/−201

@@ -1,6 +1,6 @@  name:                   music-score-version:                1.8.1+version:                1.9.0 author:                 Hans Hoglund maintainer:             Hans Hoglund license:                BSD3@@ -22,36 +22,38 @@    library     build-depends:      base                    >= 4 && < 5,+                        base-orphans            >= 0.1 && < 0.4,                         aeson                   >= 0.7.0.6 && < 1,-                        lens                    >= 4.6      && < 4.7,+                        lens                    >= 4.11     && < 5,                         process                 >= 1.2 && < 1.3,                         containers,                         nats,          -                        average                 >= 0.6 && < 1,+                        average                 >= 0.6.1    && < 1,                         semigroups              >= 0.13.0.1 && < 1,                         comonad                 >= 4.2.2 && < 5,                         contravariant           >= 1.2 && < 2,-                        bifunctors              >= 4.1.1.1 && < 5,+                        bifunctors              >= 5 && < 6,                         -- profunctors             >= 4.2.0.1 && < 5,                         distributive            >= 0.4.4 && < 5,                         adjunctions             >= 4.2 && < 5,-                        transformers            >= 0.3.0.0 && < 0.5,-                        transformers-compat     >= 0.3.3.4 && < 0.5,-                        mtl                     >= 2.1.2 && < 2.3,+                        mtl                     >= 2.1.3.1 && < 3,+                        transformers            >= 0.4.3.0 && < 0.5,+                        transformers-compat     >= 0.4.0.4 && < 0.5,                         monadplus,                         NumInstances,                         colour                  >= 2.3.3 && < 3.0,                         HCodecs                 >= 0.5 && < 0.6,-                        vector-space            >= 0.8.7 && < 0.9,-                        vector-space-points     >= 0.2 && < 0.3,-                        musicxml2               == 1.8.1,-                        lilypond                == 1.8.1,-                        music-pitch-literal     == 1.8.1,-                        music-dynamics-literal  == 1.8.1,+                        vector-space            >= 0.10.2 && < 1,+                        vector-space-points     >= 0.2 && < 1,+                        musicxml2               == 1.9.0,+                        lilypond                == 1.9.0,+                        music-pitch-literal     == 1.9.0,+                        music-dynamics-literal  == 1.9.0,                         prettify,-                        parsec+                        parsec                  >= 3.1.9 && < 4     exposed-modules:    Data.Clipped                         Data.PairMonad+                        Data.AffineSpace.Point.Offsets                         Data.Functor.Couple                         Data.Functor.Context                         Data.Functor.Rep.Lens@@ -73,14 +75,9 @@                         Music.Time.Event                         Music.Time.Future                         Music.Time.Past-                        Music.Time.Nominal-                        Music.Time.Graces                         Music.Time.Track                         Music.Time.Voice-                        Music.Time.Chord                         Music.Time.Score-                        -- Music.Time.Linear   ?-                        -- Music.Time.Spline   ?                         Music.Time.Segment                         Music.Time.Behavior                         Music.Time.Reactive@@ -103,7 +100,6 @@                         Music.Score.Meta.Title                         Music.Score.Meta.Pickup                         Music.Score.Meta.Extract-                        -- Music.Score.Clef                         Music.Score.Pitch                         Music.Score.Articulation                         Music.Score.Dynamics

@@ -0,0 +1,51 @@++module Data.AffineSpace.Point.Offsets (+      offsetPoints,+      pointOffsets,+      offsetVs,+      distanceVs,+      -- offsetted,+  ) where++import Data.AffineSpace+import Data.VectorSpace+import Data.List+import Data.AffineSpace.Point++-- | Lay out a series of vectors from a given point. Return all intermediate points.+--+-- > lenght xs + 1 == length (offsetPoints p xs)+--+-- >>> offsetPoints 0 [1,1,1] :: [Time]+-- [0,1,2,3]+offsetPoints :: AffineSpace p => p -> [Diff p] -> [p]+offsetPoints = scanl (.+^)++-- | Calculate the relative difference between vectors.+--+-- > lenght xs + 1 == length (offsetPoints p xs)+--+-- >>> offsetPoints 0 [1,1,1] :: [Time]+-- [0,1,2,3]+pointOffsets :: AffineSpace p => p -> [p] -> [Diff p]+pointOffsets or = (zeroV :) . snd . mapAccumL g or+  where+    g prev p = (p, p .-. prev)++-- How they should really have been defined++-- |+-- For all p+-- > offsetVs p . distanceVs p = id +-- > distanceVs p . offsetVs p = id +offsetVs :: AffineSpace p => p -> [Diff p] -> [p]+offsetVs p = tail . offsetPoints p++distanceVs :: AffineSpace p => p -> [p] -> [Diff p]+distanceVs p = tail . pointOffsets p++{-+offsetted :: AffineSpace p => p -> Iso' [Diff p] [p]+offsetted = iso distanceVs offsetVs+-}+

@@ -1,5 +1,4 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveFunctor #-}@@ -16,10 +15,6 @@  -- TODO move these to semigroups and music-pitch-literal -#if !MIN_VERSION_base(4,7,0)-deriving instance Num a => Num (Sum a)-#endif- deriving instance Real a => Real (Sum a) deriving instance Fractional a => Fractional (Sum a) deriving instance AdditiveGroup a => AdditiveGroup (Sum a)@@ -33,10 +28,6 @@   Sum p .-. Sum q = Sum (p .-. q)   Sum p .+^ Sum v = Sum (p .+^ v) --#if !MIN_VERSION_base(4,7,0)-deriving instance Num a => Num (Product a)-#endif  deriving instance Real a => Real (Product a) deriving instance Fractional a => Fractional (Product a)

@@ -12,17 +12,6 @@ -------------------------------------------------------------------------------------  module Music.Score (-        module Control.Lens,-        module Control.Applicative,-        module Control.Monad,-        module Control.Monad.Plus,-        module Data.Semigroup,-        module Data.VectorSpace,-        module Data.AffineSpace,-        module Data.AffineSpace.Point,--        module Music.Time,-        -- module Music.Score.Combinators,         module Music.Score.Part,         module Music.Score.Pitch,         module Music.Score.Dynamics,@@ -58,6 +47,17 @@         module Music.Score.Export.SuperCollider,         module Music.Score.Export.Lilypond,         module Music.Score.Export.MusicXml,++        module Music.Time,++        module Control.Lens,+        module Control.Applicative,+        module Control.Monad,+        module Control.Monad.Plus,+        module Data.Semigroup,+        module Data.VectorSpace,+        module Data.AffineSpace,+        module Data.AffineSpace.Point, ) where 

@@ -81,6 +81,10 @@   setColor s = fmap (setColor s) instance HasColor a => HasColor (Score a) where   setColor s = fmap (setColor s)+instance HasColor a => HasColor (Voice a) where+  setColor s = fmap (setColor s)+instance HasColor a => HasColor (Note a) where+  setColor s = fmap (setColor s) instance HasColor a => HasColor (PartT n a) where   setColor s = fmap (setColor s) instance HasColor a => HasColor (TieT a) where

@@ -191,6 +191,15 @@ type instance Dynamic (Score a)       = Dynamic a type instance SetDynamic b (Score a)  = Score (SetDynamic b a) +type instance Dynamic (Aligned a) = Dynamic a+type instance SetDynamic b (Aligned a) = Aligned (SetDynamic b a)++instance HasDynamics a b => HasDynamics (Aligned a) (Aligned b) where+  dynamics = _Wrapped . dynamics++++ instance HasDynamic a b => HasDynamic (c, a) (c, b) where   dynamic = _2 . dynamic @@ -363,20 +372,14 @@ -- | -- Fade in. ---fadeIn :: (-  HasPosition a, HasDynamics a a, -  Dynamic a ~ Behavior c, Fractional c-  ) => Duration -> a -> a-fadeIn d x = x & dynamics *~ ((_onset x >-> d) `transform` unit)+fadeIn :: (HasPosition a, Transformable a, HasDynamics' a, Dynamic a ~ Behavior c, Fractional c) => Duration -> a -> a+fadeIn d x = x & dynamics *~ ((x^.onset >-> d) `transform` unit)  -- | -- Fade in. ---fadeOut :: (-  HasPosition a, HasDynamics a a, -  Dynamic a ~ Behavior c, Fractional c-  ) => Duration -> a -> a-fadeOut d x = x & dynamics *~ ((d <-< _offset x) `transform` rev unit)+fadeOut :: (HasPosition a, Transformable a, HasDynamics' a, Dynamic a ~ Behavior c, Fractional c) => Duration -> a -> a+fadeOut d x = x & dynamics *~ ((d <-< (x^.offset)) `transform` rev unit)   

@@ -54,8 +54,8 @@ import           Data.Monoid.Average import           Data.Ratio import           Data.Traversable              (Traversable, sequenceA)-import qualified Music.Lilypond                as Lilypond-import qualified Music.MusicXml.Simple         as MusicXml+import qualified Data.Music.Lilypond                as Lilypond+import qualified Data.Music.MusicXml.Simple         as MusicXml import           Music.Score.Internal.Export   hiding (MVoice) import           System.Process import           Music.Score.Internal.Quantize

@@ -101,7 +101,7 @@ import           Music.Time import           Music.Score.Internal.Quantize -import qualified Music.Lilypond                          as Lilypond+import qualified Data.Music.Lilypond                     as Lilypond   

@@ -51,8 +51,6 @@ import           Data.Maybe import           Data.Ratio import           Data.Traversable              (Traversable, sequenceA)-import qualified Music.Lilypond                as Lilypond-import qualified Music.MusicXml.Simple         as MusicXml import           Music.Score.Internal.Export   hiding (MVoice) import           System.Process import           Music.Score.Internal.Quantize

@@ -97,7 +97,7 @@ import           Music.Score.Internal.Quantize  import qualified Text.Pretty                             as Pretty-import qualified Music.MusicXml.Simple                   as MusicXml+import qualified Data.Music.MusicXml.Simple              as MusicXml   -- |@@ -106,7 +106,7 @@ -- class HasMusicXmlInstrument a where   getMusicXmlClef :: a -> Int-+  getMusicXmlNumberOfStaves :: a -> Int   @@ -135,7 +135,7 @@   deriving (Eq, Show)  -data StaffInfo = StaffInfo { staffClef :: (MusicXml.ClefSign, MusicXml.Line) }+data StaffInfo = StaffInfo { staffClef :: (MusicXml.ClefSign, MusicXml.Line), staffCount :: Int }   deriving (Eq, Show)  data BarInfo = BarInfo { x_barTimeSignature :: Maybe TimeSignature }@@ -210,6 +210,7 @@         <> MusicXml.defaultDivisions         <> MusicXml.defaultKey         <> MusicXml.metronome (realToFrac nv) (realToFrac bpm)+        <> MusicXml.staves (staffCount info) -- TODO         -- <> Xml.commonTime     (nv, bpm) = getTempo tempo @@ -238,7 +239,29 @@ setDefaultVoice :: MusicXml.Music -> MusicXml.Music setDefaultVoice = MusicXml.setVoice 1 +{-+Sibelius quirks +Only looks at the part-name attribute (use part-name-display/display-text to override name)+Expects transposition first, i.e. "C Trumpet, Bb Clarinet"+Expects "French Horn", "Cello" and "English Horn"+Does not like numbers (I, II etc) after the instrument name+-}+toAcceptableName :: Show a => a -> (String, String)+toAcceptableName x = (overrideName defName, defName)+  where+    defName = show x+    overrideName y+      | "Clarinet"      `Data.List.isPrefixOf` y = "Bb Clarinet"+      | "Clarinet in A" `Data.List.isPrefixOf` y = "A Clarinet"+      | "Bassoon"       `Data.List.isPrefixOf` y = "Bassoon"+      | "Violoncello"   `Data.List.isPrefixOf` y = "Cello"+      | "Trumpet in Bb" `Data.List.isPrefixOf` y = "Bb Trumpet"+      | "Trumpet in C"  `Data.List.isPrefixOf` y = "C Trumpet"+      | "Trumpet in C"  `Data.List.isPrefixOf` y = "C Trumpet"+      | "Horn"          `Data.List.isPrefixOf` y = "French Horn"+      | otherwise                                = y+ instance (   HasDynamicNotation a b c,   HasOrdPart a, Transformable a, Semigroup a,@@ -258,7 +281,7 @@     where       title    = fromMaybe "" $ flip getTitleAt 0              $ metaAtStart score       composer = fromMaybe "" $ flip getAttribution "composer" $ metaAtStart score-      partList = MusicXml.partList (fmap show $ allParts score)+      partList = MusicXml.partListDisplay (fmap toAcceptableName $ allParts score)       tempo    = (metaAtStart score :: Tempo)       (timeSignatureMarks, barDurations) = extractTimeSignatures score @@ -277,7 +300,8 @@       exportStaff :: Tiable a         => [Maybe TimeSignature]         -> [Duration]-        -> Int    -- ^ clef, as per Music.Parts+        -> Int    -- Clef, as per Music.Parts+        -> Int    -- Number of staff lines          -> MVoice a         -> XmlStaff (XmlContext a) @@ -291,10 +315,10 @@         -> Rhythm (XmlContext a)        exportPart timeSignatureMarks barDurations part-        = exportStaff timeSignatureMarks barDurations (getMusicXmlClef part)+        = exportStaff timeSignatureMarks barDurations (getMusicXmlClef part) (getMusicXmlNumberOfStaves part)         . view singleMVoice -      exportStaff timeSignatures barDurations clefId+      exportStaff timeSignatures barDurations clefId staffCount'         = XmlStaff         . addStaffInfo         . zipWith exportBar timeSignatures@@ -304,7 +328,7 @@             0 -> (MusicXml.GClef, 2)             1 -> (MusicXml.CClef, 3)             2 -> (MusicXml.FClef, 4)-          addStaffInfo  = (,) $ StaffInfo { staffClef = clef }+          addStaffInfo  = (,) $ StaffInfo { staffClef = clef, staffCount = staffCount' }           splitIntoBars = splitTiesAt        exportBar timeSignature@@ -319,6 +343,7 @@           -- FIXME propagate quantization errors           handleErrors (Left e)  = error $ "Quantization failed: " ++ e           handleErrors (Right x) = x+  -------------------------------------------------------------------------------- 

@@ -48,8 +48,6 @@ import           Data.Maybe import           Data.Ratio import           Data.Traversable              (Traversable, sequenceA)-import qualified Music.Lilypond                as Lilypond-import qualified Music.MusicXml.Simple         as MusicXml import           Music.Score.Internal.Export   hiding (MVoice) import           System.Process import           Music.Score.Internal.Quantize

@@ -56,8 +56,6 @@ import           Data.Maybe import           Data.Ratio import           Data.Traversable              (Traversable, sequenceA)-import qualified Music.Lilypond                as Lilypond-import qualified Music.MusicXml.Simple         as MusicXml import           Music.Score.Internal.Export   hiding (MVoice) import           System.Process import           Music.Score.Internal.Quantize

@@ -30,9 +30,10 @@  import           Music.Pitch.Literal       (IsPitch) -import           Codec.Midi                hiding (Track)+import           Codec.Midi                (Midi) import           Control.Applicative import           Control.Lens+import Control.Monad.Plus -- import           Control.Reactive          hiding (Event) -- import qualified Control.Reactive          as R -- import           Control.Reactive.Midi@@ -51,12 +52,15 @@ import           Music.Score.Tremolo import           Music.Time +import qualified Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map+ import qualified Codec.Midi                as Midi import qualified Data.List                 as List import qualified Data.Map                  as Map-import qualified Music.Lilypond            as Lilypond-import qualified Music.MusicXml.Simple     as Xml import qualified Text.Pretty               as Pretty+import Data.Monoid  import qualified Music.Pitch.Literal       as Pitch -- import qualified Data.ByteString.Lazy as ByteString@@ -78,11 +82,66 @@     )  --- |--- Convert a score from a Midi representation.---+-- -- type SimpleMidi = [[(Time, Bool, Int, Int)]]  -- outer: track, inner: channel, time, on/off, pitch, vel+-- -- -- Ignore offset velocities (can't represent them)+-- -- type SimpleMidi2 = [[(Span, Int, Int)]] -- outer: track, inner: channel, time, pitch, vel+-- -- +-- -- foo :: SimpleMidi2+-- -- foo = undefined+-- +-- mapWithIndex :: (Int -> a -> b) -> [a] -> [b]+-- mapWithIndex f = zipWith f [0..]+-- +-- mapWithIndex2 :: (Int -> Int -> a -> b) -> [[a]] -> [b]+-- mapWithIndex2 f xss = concat $ zipWith (\m -> zipWith (f m) [0..]) [0..] xss+-- +-- -- Last time the given key was pressed but not released (non-existant means it is not pressed)+-- type ChanMap = Map Int Time+-- +-- -- |+-- -- Convert a score from a Midi representation.+-- -- fromMidi :: IsMidi a => Midi -> Score a-fromMidi = undefined+fromMidi m = undefined+--   where+-- +-- toAspects :: [[Event (Midi.Channel,Midi.Key,Midi.Velocity)]] -> [Event (Part,Int,Int)]+-- toAspects = mapWithIndex (\trackN events -> over (mapped.event) (\(s,(ch,key,vel)) -> undefined))+--     +-- getMidi :: Midi.Midi -> [[Event (Midi.Channel,Midi.Key,Midi.Velocity)]]+-- getMidi (Midi.Midi fileType timeDiv tracks) = id+--       $ compress (ticksp timeDiv)+--       $ fmap mcatMaybes+--       $ fmap snd+--       $ fmap (List.mapAccumL g mempty)+--       $ fmap mcatMaybes $ over (mapped.mapped) getMsg tracks+--   where+--     g keyStatus (t,onOff,c,p,v) = +--       ( updateKeys onOff p (fromIntegral t) keyStatus+--       , (if onOff then Nothing else Just (+--         (Data.Maybe.fromMaybe 0 (Map.lookup (fromIntegral t) keyStatus)<->fromIntegral t,(c,p,60))^.event))+--       )+--     -- TODO also store dynamics in pitch map (to use onset value rather than offset value)+--     -- For now just assume 60+--     updateKeys True  p t = Map.insert p t+--     updateKeys False p _ = Map.delete p+-- +--     -- Amount to compress time (after initially treating each tick as duration 1) +--     ticksp (Midi.TicksPerBeat n)     = 1 / fromIntegral n+--     ticksp (Midi.TicksPerSecond _ _) = error "fromMidi: Can not parse TickePerSecond-based files"+-- +-- getMsg (t, Midi.NoteOff c p v) = Just (t,False,c,p,v)+-- getMsg (t, Midi.NoteOn c p 0)  = Just (t,False,c,p,0)+-- getMsg (t, Midi.NoteOn c p v)  = Just (t,True,c,p,v)+-- -- TODO key pressure+-- -- control change+-- -- program change+-- -- channel pressure+-- -- pitch wheel+-- -- etc.+-- getMsg _ = Nothing+--     +     -- Map each track to a part (scanning for ProgramChange, name etc)     -- Subdivide parts based on channels     -- Set channel 10 tracks to "percussion"@@ -116,6 +175,6 @@ -- @Left m@ if a parsing error occurs. -- readMidiEither :: IsMidi a => FilePath -> IO (Either String (Score a))-readMidiEither path = fmap (fmap fromMidi) $ importFile path+readMidiEither path = fmap (fmap fromMidi) $ Midi.importFile path  

@@ -62,8 +62,6 @@ import qualified Codec.Midi               as Midi import qualified Data.List                as List import qualified Data.Map                 as Map-import qualified Music.Lilypond           as Lilypond-import qualified Music.MusicXml.Simple    as Xml import qualified System.Info              as Info import qualified Text.Pretty              as Pretty 

@@ -316,10 +316,8 @@ type instance Dynamic (a,b,c) = (a,b,c) type instance SetDynamic g (a,b,c) = g -instance Transformable a => Transformable (Maybe a) where-  transform s = fmap (transform s)-instance (Transformable a, Transformable b, Transformable c) => Transformable (a,b,c) where-  transform s (a,b,c) = (transform s a,transform s b,transform s c)+-- instance (Transformable a, Transformable b, Transformable c) => Transformable (a,b,c) where+--   transform s (a,b,c) = (transform s a,transform s b,transform s c)  -- TODO place for this? -- For use with single-note scores etc

@@ -5,6 +5,7 @@ {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE ViewPatterns               #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}  ------------------------------------------------------------------------------------- -- |@@ -31,7 +32,8 @@         dotMod,                  -- * Utility-        drawRhythm+        drawRhythm,+        testQuantize,   ) where  import           Prelude             hiding (concat, concatMap, foldl, foldr,@@ -67,6 +69,12 @@   deriving (Eq, Show, Functor, Foldable)   -- RInvTuplet  Duration (Rhythm a) +instance Transformable (Rhythm a) where+  transform s (Beat d x) = Beat (transform s d) x+  transform s (Group rs) = Group (fmap (transform s) rs)+  transform s (Dotted n r) = Dotted n (transform s r) +  transform s (Tuplet n r) = Tuplet n (transform s r) + getBeatValue :: Rhythm a -> a getBeatValue (Beat d a) = a getBeatValue _          = error "getBeatValue: Not a beat"@@ -127,9 +135,9 @@  instance HasDuration (Rhythm a) where   _duration (Beat d _)        = d-  _duration (Dotted n a)      = _duration a * dotMod n-  _duration (Tuplet c a)      = _duration a * c-  _duration (Group as)        = sum (fmap _duration as)+  _duration (Dotted n a)      = a^.duration * dotMod n+  _duration (Tuplet c a)      = a^.duration * c+  _duration (Group as)        = sum (fmap (^.duration) as)  instance AdditiveGroup (Rhythm a) where   zeroV   = error "No zeroV for (Rhythm a)"@@ -171,7 +179,7 @@   go (Dotted n r)   = Dotted n ((rewriteR . rewrite1) r)   go (Tuplet n r)   = Tuplet n ((rewriteR . rewrite1) r) -rewrite1 = tupletDot . splitTupletIfLongEnough . singleGroup+rewrite1 = tupletDot . {-splitTupletIfLongEnough .-} singleGroup  -- | Removes single-note groups singleGroup :: Rhythm a -> Rhythm a@@ -184,7 +192,7 @@ tupletDot orig                                                       = orig  splitTupletIfLongEnough :: Rhythm a -> Rhythm a-splitTupletIfLongEnough r = if _duration r > (1/2) then splitTuplet r else r+splitTupletIfLongEnough r = if r^.duration > (1/2) then splitTuplet r else r -- TODO should compare against beat duration, not just (1/4)  -- | Splits a tuplet iff it contans a group which can be split into two halves whose@@ -199,7 +207,7 @@ trySplit = firstJust . fmap g . splits   where     g (part1, part2)-      | (sum . fmap _duration) part1 `rel` (sum . fmap _duration) part2 = Just (part1, part2)+      | (sum . fmap (^.duration)) part1 `rel` (sum . fmap (^.duration)) part2 = Just (part1, part2)       | otherwise = Nothing     rel x y       | x   == y   = True@@ -221,15 +229,26 @@ firstJust :: [Maybe a] -> Maybe a firstJust = listToMaybe . fmap fromJust . List.dropWhile isNothing -+{-+For now, try both strategies (first original, then quSimp).+-} quantize :: Tiable a => [(Duration, a)] -> Either String (Rhythm a)-quantize = quantize' (atEnd rhythm)+quantize xs = case quOrig xs of+  Right x -> Right x+  Left e1 -> case quSimp xs of+    Right x -> Right x+    Left e2 -> Left $ e1 ++ ", " ++ e2  testQuantize :: [Duration] -> IO ()-testQuantize x = case fmap rewrite $ quantize' (atEnd rhythm) $ fmap (\x -> (x,())) $ x of+testQuantize x = case fmap rewrite $ qAlg $ fmap (\x -> (x,())) $ x of   Left e -> error e   Right x -> putStrLn $ drawRhythm x+  where+    -- qAlg = quOrig+    -- qAlg = quSimp+    qAlg = quantize +quOrig = quantize' (atEnd rhythm)  konstNumDotsAllowed :: [Int] konstNumDotsAllowed = [1..2]@@ -279,7 +298,7 @@ type RhythmParser a b = Parsec [(Duration, a)] RhythmContext b  quantize' :: Tiable a => RhythmParser a b -> [(Duration, a)] -> Either String b-quantize' p = over _Left show . runParser p mempty ""+quantize' p rh = over _Left show . runParser p mempty ("Rhythm pattern: '" ++ show (fmap fst rh) ++ "'") $ rh   @@ -318,9 +337,15 @@ dotted = msum . fmap dotted' $ konstNumDotsAllowed  -- | Matches a bound rhythm+-- TODO this should be abolished, see below! bound :: Tiable a => RhythmParser a (Rhythm a)-bound = msum . fmap bound' $ konstBounds+bound = msum $ fmap bound' $ konstBounds+-- bound = msum $ fmap bound' $ (konstBounds <> fmap (*(3/2)) konstBounds) +{-+What this should really do is to split the rhythm into two rhythms where the first have the bound duration...+-}+ -- | Matches a tuplet tuplet :: Tiable a => RhythmParser a (Rhythm a) tuplet = msum . fmap tuplet' $ konstTuplets@@ -352,9 +377,13 @@   a <- beat   modifyState $ modifyTimeSub (subtract d)   let (b,c) = toTied $ getBeatValue a-+     -- TODO doesn't know order-  return $ Group [Beat (getBeatDuration a) b, Beat d c]+  -- Need to have relative phase in the parser context!+  return $ Group [Beat (getBeatDuration a) b, +    Beat d c+    -- if isPowerOf2 d then Beat d c else if isPowerOf2 (d*(2/3)) then Dotted 1 (Beat (d*(2/3)) c) else (error "Bad bound rhythm")+      ]  -- tuplet' 2/3 for triplet, 4/5 for quintuplet etc tuplet' :: Tiable a => Duration -> RhythmParser a (Rhythm a)@@ -379,7 +408,7 @@ -- many2 :: Stream s m t => ParsecT s u m a -> ParsecT s u m [a] -- many2 p = do { x <- p; xs <- many1 p; return (x : xs) } --- Matches a (_duration, value) pair iff the predicate matches, returns beat+-- Matches a (duration, value) pair iff the predicate matches, returns beat match :: Tiable a => (Duration -> a -> Bool) -> RhythmParser a (Rhythm a) match p = tokenPrim show next test   where@@ -387,7 +416,7 @@       next pos _ _  = updatePosChar pos 'x'       test (d,x)    = if p d x then Just (Beat d x) else Nothing --- Matches a (_duration, value) pair iff the predicate matches, returns beat+-- Matches a (duration, value) pair iff the predicate matches, returns beat match' :: Tiable a => (Duration -> a -> Maybe (Duration, b)) -> RhythmParser a (Rhythm b) match' f = tokenPrim show next test   where@@ -436,9 +465,39 @@  -- As it sounds, do NOT use infix -- Only works for simple n such as 2 or 3, TODO determine-isPowerOf :: Duration -> Duration -> Bool+-- isPowerOf :: Duration -> Duration -> Bool isPowerOf n = (== 0.0) . snd . properFraction . logBaseR (toRational n) . toRational -isPowerOf2 :: Duration -> Bool+-- isPowerOf2 :: Duration -> Bool isPowerOf2 = isPowerOf 2++greatestSmallerPowerOf2 :: Integer -> Integer+greatestSmallerPowerOf2 x+  | x < 0        = error "greatestSmallerPowerOf2: Must be > 0"+  | isPowerOf2 x = x+  | otherwise    = greatestSmallerPowerOf2 (x - 1)+++{-+An "emergency" quantizer that ignores input durations and outputs a single beat sequence+with all notes in the same length.+-}+quSimp :: Tiable a => [(Duration, a)] -> Either String (Rhythm a)+quSimp = Right . qu1 1+-- quSimp xs = if isPowerOf2 totDur then (Right $ qu1 totDur xs)+--   else Left ("This strategy only works for total duration that are powers of two (i.e. 4/4, 2/4), given"++show totDur)+  where+--     totDur = sum $ fmap fst xs+    qu1 totDur xs = if isPowerOf2 n then +                  Group (fmap (\(_,a) -> Beat (totDur/fromIntegral n) a) xs) else+      Tuplet (q) (Group (fmap (\(_,a) -> Beat (totDur/fromIntegral p) a) xs)) +      where+        q = fromIntegral p / fromIntegral n :: Duration+        p = greatestSmallerPowerOf2 n :: Integer+        n = fromIntegral $ length xs+    -- (1/n) = q(1/p)+    -- (1/n) = (p/n)(1/p)+    -- (1/n) = (p/np)+    -- (1/n) = (1/n)+ 

@@ -72,7 +72,7 @@ metaAt x = (`atTime` x) . runScoreMeta  metaAtStart :: AttributeClass b => Score a -> b-metaAtStart x = _onset x `metaAt` x+metaAtStart x = (x^.onset) `metaAt` x  withMeta :: AttributeClass a => (a -> Score b -> Score b) -> Score b -> Score b withMeta f x = let@@ -90,7 +90,7 @@ withMetaAtStart :: AttributeClass a => (a -> Score b -> Score b) -> Score b -> Score b withMetaAtStart f x = let     m = view meta x-    in f (fromMetaReactive m `atTime` _onset x) x+    in f (fromMetaReactive m `atTime` (x^.onset)) x   

@@ -248,7 +248,7 @@         f (view (from note) -> (view delta -> (t,u),x)) = TempoRegion0 t u (tempoToDuration x)  tempoRegions :: Span -> [TempoRegion0] -> [TempoRegion]-tempoRegions s = snd . List.mapAccumL f (_onset s, _onset s) -- XXX offset?+tempoRegions s = snd . List.mapAccumL f (s^.onset, s^.onset) -- XXX offset?     where         f (nt,st) (TempoRegion0 _ d x) = ((nt .+^ d, st .+^ (d*x)),             TempoRegion nt (nt .+^ d) st x

@@ -52,7 +52,7 @@         standardTimeSignature,   ) where -import           Control.Lens              (view)+import           Control.Lens              (view, (^.)) import           Control.Monad.Plus import           Data.Bifunctor import           Data.Foldable             (Foldable)@@ -161,10 +161,10 @@ getTimeSignature (TimeSignature x) = x  -- | Set the time signature of the given score.-timeSignature :: (HasMeta a, HasPosition a) => TimeSignature -> a -> a-timeSignature c x = timeSignatureDuring (0 <-> _offset x) c x+timeSignature :: (HasMeta a, HasPosition a, Transformable a) => TimeSignature -> a -> a+timeSignature c x = timeSignatureDuring (0 <-> x^.offset) c x --- use (_onset x <-> _offset x) instead of (0 <-> _offset x)+-- use (x^.onset <-> x^.offset) instead of (0 <-> x^.offset) -- timeSignature' c x = timeSignatureDuring (era x) c x  -- | Set the time signature of the given part of a score.

@@ -188,6 +188,12 @@ type instance Part (Either c a) = Part a type instance SetPart b (Either c a) = Either c (SetPart b a) +type instance Part (Aligned a) = Part a+type instance SetPart b (Aligned a) = Aligned (SetPart b a)++instance HasParts a b => HasParts (Aligned a) (Aligned b) where+  parts = _Wrapped . parts+ instance HasPart a b => HasPart (c, a) (c, b) where   part = _2 . part @@ -212,6 +218,15 @@  instance (HasParts a b) => HasParts (Event a) (Event b) where   parts = from event . whilstL parts++type instance Part (Note a) = Part a+type instance SetPart g (Note a) = Note (SetPart g a)++instance (HasPart a b) => HasPart (Note a) (Note b) where+  part = from note . whilstLD part++instance (HasParts a b) => HasParts (Note a) (Note b) where+  parts = from note . whilstLD parts  -- | -- List all the parts

@@ -43,7 +43,7 @@         -- * HasPitch classes         HasPitch(..),         HasPitches(..),-        fromPitch',+        -- fromPitch',          -- ** Simple versions         HasPitch',@@ -61,30 +61,18 @@         below,         octavesUp,         octavesDown,-        octavesAbove,-        octavesBelow,-        fifthsUp,-        fifthsDown,-        fifthsAbove,-        fifthsBelow,         _15va,         _8va,         _8vb,         _15vb,          -- * Inversion-        inv,         invertPitches,          -- * Folds         highest,         lowest,         meanPitch,--        -- -- * Intervals-        -- augmentIntervals,-        -- TODO pitchIs, to write filter pitchIs ... etc-        -- TODO gliss etc           ) where  import           Control.Applicative@@ -99,6 +87,7 @@ import           Data.Ratio import           Data.Semigroup import           Data.String+import           Data.Monoid.Average import           Data.Traversable              (Traversable) import           Data.Typeable import           Data.VectorSpace              hiding (Sum)@@ -221,7 +210,7 @@ -- -- Same as 'pitch', but without polymorphic update. ---pitch' :: (HasPitch s t, s ~ t) => Lens' s (Pitch s)+pitch' :: HasPitch' s => Lens' s (Pitch s) pitch' = pitch {-# INLINE pitch' #-} @@ -230,10 +219,11 @@ --  -- Same as 'pitches', but without polymorphic update. ---pitches' :: (HasPitches s t, s ~ t) => Traversal' s (Pitch s)+pitches' :: HasPitches' s => Traversal' s (Pitch s) pitches' = pitches {-# INLINE pitches' #-} +{- -- | -- Inject a pitch into some larger type. --@@ -241,6 +231,7 @@ fromPitch' x = c & pitches' .~ x {-# INLINE fromPitch' #-} -- TODO swap name of this and Music.Pitch.Literal.fromPitch (or call that something else, i.e. fromPitchL)+-}   #define PRIM_PITCH_INSTANCE(TYPE)       \@@ -295,20 +286,17 @@ type instance Pitch (Score a)             = Pitch a type instance SetPitch b (Score a)        = Score (SetPitch b a) +type instance Pitch (Aligned a) = Pitch a+type instance SetPitch b (Aligned a) = Aligned (SetPitch b a)++instance HasPitches a b => HasPitches (Aligned a) (Aligned b) where+  pitches = _Wrapped . pitches+ instance HasPitch a b => HasPitch (c, a) (c, b) where   pitch = _2 . pitch instance HasPitches a b => HasPitches (c, a) (c, b) where   pitches = traverse . pitches -instance HasPitches a b => HasPitches [a] [b] where-  pitches = traverse . pitches--instance HasPitches a b => HasPitches (Seq a) (Seq b) where-  pitches = traverse . pitches--instance HasPitches a b => HasPitches (Map k a) (Map k b) where-  pitches = traverse . pitches- instance (HasPitches a b) => HasPitches (Event a) (Event b) where   pitches = from event . whilstL pitches instance (HasPitch a b) => HasPitch (Event a) (Event b) where@@ -324,6 +312,15 @@ instance (HasPitch a b) => HasPitch (Note a) (Note b) where   pitch = _Wrapped . whilstLD pitch +instance HasPitches a b => HasPitches [a] [b] where+  pitches = traverse . pitches++instance HasPitches a b => HasPitches (Seq a) (Seq b) where+  pitches = traverse . pitches++instance HasPitches a b => HasPitches (Map k a) (Map k b) where+  pitches = traverse . pitches+ instance HasPitches a b => HasPitches (Maybe a) (Maybe b) where   pitches = traverse . pitches @@ -423,9 +420,7 @@   )  -- |--- Transpose pitch upwards.------ Not to be confused with matrix transposition.+-- Transpose (translate) up. -- -- >>> up m3 (c :: Pitch) -- eb@@ -438,12 +433,9 @@ -- up :: Transposable a => Interval a -> a -> a up v = pitches %~ (.+^ v)-{-# INLINE up #-}  -- |--- Transpose pitch downwards.------ Not to be confused with matrix transposition.+-- Transpose (translate) down. -- -- >>> down m3 (c :: Pitch) -- a@@ -453,7 +445,6 @@ -- down :: Transposable a => Interval a -> a -> a down v = pitches %~ (.-^ v)-{-# INLINE down #-}  -- | -- Add the given interval above.@@ -463,7 +454,6 @@ -- above :: (Semigroup a, Transposable a) => Interval a -> a -> a above v x = x <> up v x-{-# INLINE above #-}  -- | -- Add the given interval below.@@ -473,12 +463,7 @@ -- below :: (Semigroup a, Transposable a) => Interval a -> a -> a below v x = x <> down v x-{-# INLINE below #-} -inv :: Transposable a => Pitch a -> a -> a-inv = invertPitches-{-# DEPRECATED inv "Use 'invertPitches'" #-}- -- | -- Invert pitches. --@@ -499,7 +484,6 @@ -- octavesUp :: Transposable a => Scalar (Interval a) -> a -> a octavesUp n = up (_P8^*n)-{-# INLINE octavesUp #-}  -- | -- Transpose down by the given number of octaves.@@ -515,101 +499,32 @@ -- octavesDown :: Transposable a => Scalar (Interval a) -> a -> a octavesDown n = down (_P8^*n)-{-# INLINE octavesDown #-} --- |--- Add the given octave above.----octavesAbove :: (Semigroup a, Transposable a) => Scalar (Interval a) -> a -> a-octavesAbove n = above (_P8^*n)-{-# INLINE octavesAbove #-}---- |--- Add the given octave below.----octavesBelow :: (Semigroup a, Transposable a) => Scalar (Interval a) -> a -> a-octavesBelow n = below (_P8^*n)-{-# INLINE octavesBelow #-}---- |--- Transpose up by the given number of fifths.----fifthsUp :: Transposable a => Scalar (Interval a) -> a -> a-fifthsUp n = up (_P8^*n)-{-# INLINE fifthsUp #-}---- |--- Transpose down by the given number of fifths.----fifthsDown :: Transposable a => Scalar (Interval a) -> a -> a-fifthsDown n = down (_P8^*n)-{-# INLINE fifthsDown #-}---- |--- Add the given octave above.----fifthsAbove :: (Semigroup a, Transposable a) => Scalar (Interval a) -> a -> a-fifthsAbove n = above (_P8^*n)-{-# INLINE fifthsAbove #-}---- |--- Add the given octave below.----fifthsBelow :: (Semigroup a, Transposable a) => Scalar (Interval a) -> a -> a-fifthsBelow n = below (_P8^*n)-{-# INLINE fifthsBelow #-}---- | Shorthand for @'octavesUp' 2@.+-- | Same as @'octavesUp' 2@. _15va :: Transposable a => a -> a _15va = octavesUp 2-{-# INLINE _15va #-} --- | Shorthand for @'octavesUp' 1@.+-- | Same as @'octavesUp' 1@. _8va :: Transposable a => a -> a _8va  = octavesUp 1-{-# INLINE _8va #-} --- | Shorthand for @'octavesDown' 1@.+-- | Same as @'octavesDown' 1@. _8vb :: Transposable a => a -> a _8vb  = octavesDown 1-{-# INLINE _8vb #-} --- | Shorthand for @'octavesDown' 2@.+-- | Same as @'octavesDown' 2@. _15vb :: Transposable a => a -> a _15vb = octavesDown 2-{-# INLINE _15vb #-} ---- |--- Return the highest pitch in the given music.---+-- | Extract the highest pitch. Returns @Nothing@ if there are none. highest :: (HasPitches' a, Ord (Pitch a)) => a -> Maybe (Pitch a) highest = maximumOf pitches' --- |--- Return the lowest pitch in the given music.---+-- | Extract the lowest pitch. Returns @Nothing@ if there are none. lowest :: (HasPitches' a, Ord (Pitch a)) => a -> Maybe (Pitch a) lowest = minimumOf pitches' --- |--- Return the mean pitch in the given music.----meanPitch :: (HasPitches' a, Fractional (Pitch a)) => a -> Pitch a-meanPitch = mean . toListOf pitches'-  where-    mean x = fst $ foldl (\(m, n) x -> (m+(x-m)/(n+1),n+1)) (0,0) x---augmentIntervals :: (HasPhrases' s a, Transposable a) => Interval a -> s -> s-augmentIntervals x = over phrases (augmentIntervals' x)--augmentIntervals' :: Transposable a => Interval a -> Voice a -> Voice a-augmentIntervals' = error "Not implemented: augmentIntervals"--- TODO generalize to any type where we can traverse phrases of something that has pitch----- TODO augment/diminish intervals (requires phrase traversal)--- TODO rotatePitch (requires phrase traversal)--- TODO invert diatonically+-- | Extract the average pitch. Returns @Nothing@ if there are none.+meanPitch :: (HasPitches' a, Fractional (Pitch a)) => a -> Maybe (Pitch a)+meanPitch = maybeAverage . Average . toListOf pitches' 

@@ -12,8 +12,6 @@ -------------------------------------------------------------------------------------  module Music.Time (-    module Data.Functor.Rep.Lens,-     module Music.Time.Types,      module Music.Time.Transform,@@ -22,30 +20,29 @@     module Music.Time.Split,     module Music.Time.Reverse,     module Music.Time.Juxtapose,-    module Music.Time.Rest,     module Music.Time.Aligned, -    module Music.Time.Placed,+    module Music.Time.Rest,     module Music.Time.Note,-    module Music.Time.Event,     module Music.Time.Voice,-    module Music.Time.Chord,-    module Music.Time.Track,+    module Music.Time.Event,     module Music.Time.Score,--    module Music.Time.Nominal,-    module Music.Time.Graces,+    module Music.Time.Placed,+    module Music.Time.Track,      module Music.Time.Future,     module Music.Time.Past,     module Music.Time.Reactive,-     module Music.Time.Segment,     module Music.Time.Behavior,++    module Data.Functor.Rep.Lens,+    module Data.AffineSpace.Point.Offsets,   ) where  import           Data.Functor.Rep import           Data.Functor.Rep.Lens+import           Data.AffineSpace.Point.Offsets  import           Music.Time.Duration import           Music.Time.Juxtapose@@ -58,11 +55,8 @@ import           Music.Time.Aligned  import           Music.Time.Behavior-import           Music.Time.Chord import           Music.Time.Placed import           Music.Time.Future-import           Music.Time.Graces-import           Music.Time.Nominal import           Music.Time.Event import           Music.Time.Past import           Music.Time.Reactive

@@ -1,14 +1,15 @@ +{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}  ------------------------------------------------------------------------------------- -- |@@ -23,8 +24,12 @@ -------------------------------------------------------------------------------------  module Music.Time.Aligned (+      -- * Alignable class+      Alignable(..),+      -- * Aligned values       Aligned,       aligned,+      realign,       renderAligned,       renderAlignedVoice,       renderAlignedNote,@@ -46,18 +51,28 @@ import           Data.String import           Data.Typeable import           Data.VectorSpace+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON  import           Music.Dynamics.Literal import           Music.Pitch.Literal-import           Music.Time.Reverse++import           Music.Time.Event import           Music.Time.Juxtapose-import           Music.Time.Split import           Music.Time.Note-import           Music.Time.Event-import           Music.Time.Voice import           Music.Time.Score+import           Music.Time.Voice +-- TODO should this be a Setter or a Lens instead?+class Alignable a where+  align :: LocalDuration -> a -> a +instance Alignable a => Alignable [a] where+  align l = fmap (align l)++instance Alignable (Aligned a) where+  align l (Aligned ((t, _), a)) = Aligned ((t, l), a)+ -- type AlignedVoice a = Aligned (Voice a)  -- | 'Aligned' places a vector-like object in space, by fixing a local duration interpolating@@ -66,35 +81,49 @@ -- -- This is analogous to alignment in a graphical program. To align something at onset, midpoint -- or offset, use 0, 0.5 or 1 as the local duration value.-newtype Aligned v = Aligned { getAligned :: (Time, LocalDuration, v) }+newtype Aligned v = Aligned { getAligned :: ((Time, LocalDuration), v) }+  deriving (Functor, Eq, Ord, Foldable, Traversable) +instance Wrapped (Aligned v) where+  type Unwrapped (Aligned v) = ((Time, LocalDuration), v)+  _Wrapped' = iso getAligned Aligned++instance Rewrapped (Aligned a) (Aligned b)+ -- | Align the given value so that its local duration occurs at the given time. aligned :: Time -> LocalDuration -> v -> Aligned v-aligned t d a = Aligned (t, d, a)+aligned t d a = Aligned ((t, d), a)  instance Show a => Show (Aligned a) where-  show (Aligned (t,d,v)) = "aligned ("++show t++") ("++show d++") ("++ show v++")"+  show (Aligned ((t,d),v)) = "aligned ("++show t++") ("++show d++") ("++ show v++")" +instance ToJSON a => ToJSON (Aligned a) where+  toJSON (Aligned ((t,d),v)) = JSON.object [ ("alignment", toJSON d), ("origin", toJSON t), ("value", toJSON v) ]+ instance Transformable v => Transformable (Aligned v) where-  transform s (Aligned (t, d, v)) = Aligned (transform s t, d, transform s v)+  transform s (Aligned ((t, d), v)) = Aligned ((transform s t, d), transform s v) -instance HasDuration v => HasDuration (Aligned v) where-  _duration (Aligned (_, _, v)) = _duration v+instance (HasDuration v, Transformable v) => HasDuration (Aligned v) where+  _duration (Aligned (_, v)) = v^.duration -instance HasDuration v => HasPosition (Aligned v) where+instance (HasDuration v, Transformable v) => HasPosition (Aligned v) where   -- _position (Aligned (position, alignment, v)) = alerp (position .-^ (size * alignment)) (position .+^ (size * (1-alignment)))-  --   where-  --     size = _duration v-  _era (Aligned (position, alignment, v)) = +  _era (Aligned ((position, alignment), v)) =     (position .-^ (size * alignment)) <-> (position .+^ (size * (1-alignment)))     where-      size = _duration v---- renderAligned :: AlignedVoice a -> Score a-renderAligned :: HasDuration a => (Span -> a -> b) -> Aligned a -> b-renderAligned f a@(Aligned (_, _, v)) = f (_era a) v+      size = v^.duration +-- | Change the alignment of a value without moving it.+--+-- @+-- x^.'era' = ('realign' l x)^.'era'+-- @+realign :: (HasDuration a, Transformable a) => LocalDuration -> Aligned a -> Aligned a+realign l a@(Aligned ((t,_),x)) = Aligned ((a^.position l,l),x) +-- | Render an aligned value. The given span represents the actual span of the aligned value.+renderAligned :: (HasDuration a, Transformable a) => (Span -> a -> b) -> Aligned a -> b+renderAligned f a@(Aligned (_, v)) = f (_era a) v   -- Somewhat suspect, see below for clarity...

@@ -42,7 +42,7 @@     sawtooth,     sine,     cosine,-    +     -- ** Impulse functions     unit,     impulse,@@ -59,8 +59,8 @@ import           Data.Semigroup import           Data.Set                      (Set) import qualified Data.Set                      as Set-import           Data.VectorSpace import           Data.String+import           Data.VectorSpace import           Prelude  import           Control.Applicative@@ -69,20 +69,20 @@                                                 reversed, transform, (<|), (|>))  import           Data.Distributive-import           Data.Functor.Rep as R+import           Data.Functor.Rep              as R import           Data.Functor.Rep.Lens import           Data.Typeable-import           Music.Time.Bound-import           Music.Time.Internal.Transform-import           Music.Time.Event-import           Music.Time.Reverse-import           Music.Time.Score-import           Music.Time.Split  import           Music.Dynamics.Literal import           Music.Pitch.Alterable import           Music.Pitch.Augmentable import           Music.Pitch.Literal++import           Music.Time.Bound+import           Music.Time.Event+import           Music.Time.Internal.Transform+import           Music.Time.Juxtapose+import           Music.Time.Score   

@@ -23,7 +23,7 @@ module Music.Time.Bound (     -- * Bound type     Bound(..),-    +     -- * Construction     bounds,     bounding,@@ -33,6 +33,10 @@     -- bounded,   ) where +import           Control.Applicative+import           Control.Lens           hiding (Indexable, Level, above, below,+                                         index, inside, parts, reversed,+                                         transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point import           Data.Bifunctor@@ -42,16 +46,10 @@ import           Data.Semigroup import           Data.Set               (Set) import qualified Data.Set               as Set+import           Data.Typeable import           Data.VectorSpace -import           Music.Time.Reverse-import           Music.Time.Split--import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))-import           Data.Typeable+import           Music.Time.Juxtapose  -- | -- 'Bound' restricts the start and stop time of a value, and prevents access to values@@ -105,9 +103,6 @@   -- rev = over (_Wrapped . each) rev   rev = over _Wrapped $ (bimap rev rev) -instance (HasPosition a, Splittable a) => Splittable (Bound a) where-  -- TODO- -- | -- 'Bound' transform by transforming the bounded value as well as -- the bounds.@@ -115,10 +110,10 @@ instance Transformable a => Transformable (Bound a) where   transform t = over _Wrapped (transform t `bimap` transform t) -instance (HasPosition a, HasDuration a) => HasDuration (Bound a) where-  _duration x = _offset x .-. _onset x+instance (HasPosition a, HasDuration a, Transformable a) => HasDuration (Bound a) where+  _duration x = x^.offset .-. x^.onset -instance HasPosition a => HasPosition (Bound a) where+instance (HasPosition a, Transformable a) => HasPosition (Bound a) where   -- TODO lawless   -- _position (Bound (view range -> (t, u), x)) d = truncating t u (_position x d)   _position (Bound (view range -> (t, u), x)) = alerp t u

@@ -1,208 +0,0 @@--{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}------------------------------------------------------------------------------------------ |--- Copyright   : (c) Hans Hoglund 2012-2014------ License     : BSD-style------ Maintainer  : hans@hanshoglund.se--- Stability   : experimental--- Portability : non-portable (TF,GNTD)-------------------------------------------------------------------------------------------module Music.Time.Chord (--      -- * Chord type-      -- Chord,--      -- * Construction-      -- chord,-      -- unchord,-      -- unsafeChord,--      -- invertChord,-      -- inversions,-      -- chordToScore,-      -- arpUp3,-      -- arpDown3,-      -- arpUpDown3,-      -- arpDownUp3,-      -- alberti3,-      -- triad,-      -- mtriad,-      -- sixthChord,-      -- sixthFourthChord,-      -- fromBass,     -  ) where---import           Data.AffineSpace-import           Data.AffineSpace.Point-import           Data.Map               (Map)-import qualified Data.Map               as Map-import           Data.Ratio-import           Data.Semigroup-import           Data.Set               (Set)-import qualified Data.Set               as Set-import           Data.VectorSpace-import           Data.String--import           Music.Time.Placed-import           Music.Time.Reverse-import           Music.Time.Split--import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))-import           Control.Monad-import           Control.Monad.Compose-import           Control.Monad.Plus-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable-import           Data.Traversable       (Traversable)-import qualified Data.Traversable       as T-import           Data.Typeable--import           Music.Dynamics.Literal-import           Music.Pitch.Literal----- |--- A 'Chord' is a parallel composition of values.------ @--- type Chord a = [Placed a]--- @----newtype Chord a = Chord { getChord :: ChordList (ChordEv a) }-  deriving (Functor, Foldable, Traversable, Semigroup, Monoid, Typeable, Show, Eq)---- Can use [] or Seq here-type ChordList = []---- Can use any type as long as chordEv provides an Iso-type ChordEv a = Placed a--chordEv :: Iso (Placed a) (Placed b) (ChordEv a) (ChordEv b)-chordEv = id--instance Applicative Chord where-  pure  = return-  (<*>) = ap--instance Monad Chord where-  return = view _Unwrapped . return . return-  xs >>= f = view _Unwrapped $ (view _Wrapped . f) `mbind` view _Wrapped xs--instance Wrapped (Chord a) where-  type Unwrapped (Chord a) = (ChordList (ChordEv a))-  _Wrapped' = iso getChord Chord--instance Rewrapped (Chord a) (Chord b)---- instance Transformable (Chord a) where---   transform s = over _Wrapped' (transform s)---- instance HasDuration (Chord a) where-  -- TODO---- instance Splittable a => Splittable (Chord a) where---   -- TODO---- instance Reversible a => Reversible (Chord a) where---   rev = over _Wrapped' (fmap rev) -- TODO OK?---- TODO--- instance HasMeta (Chord a) where-  -- meta = error "Not implemented: meta"--chord :: Getter [Placed a] (Chord a)-chord = from unsafeChord--unchord :: Lens (Chord a) (Chord b) [Placed a] [Placed b]-unchord = _Wrapped---- TODO names are not consistent with other types-unsafeChord :: Iso (Chord a) (Chord b) [Placed a] [Placed b]-unsafeChord = _Wrapped--instance IsString a => IsString (Chord a) where-  fromString = pure . fromString--deriving instance IsPitch a => IsPitch (Chord a)	 -deriving instance IsInterval a => IsInterval (Chord a)	 -deriving instance IsDynamics a => IsDynamics (Chord a)---{---- |--- Invert a chord, i.e. transpose its lowest pitch up one octave.------ To access higher-numbered inversions, iterate this function, i.e.------ @--- 'iterate' 'invertC' ('triad' c) !! 2--- @----invertC :: Transposable a => Chord a -> Chord a-invertC = over chord (rotlAnd $ up _P8)---- TODO include transp-inversions :: Transposable a => Chord a -> [Chord a]-inversions = iterate invertC--chordToScore :: Chord a -> Score a-chordToScore = pcat . map pure . toListOf traverse---- TODO-unchord =  toListOf traverse---arpUp3 :: Chord a -> Score a-arpUp3 x = scat $ map ((^/16) . pure) [a,b,c]-  where-    [a,b,c] = unchord x--arpDown3 :: Chord a -> Score a-arpDown3 x = scat $ map ((^/16) . pure) [c,b,a]-  where-    [a,b,c] = unchord x--arpUpDown3 x = arpUp3 x |> arpDown3 x-arpDownUp3 x = arpDown3 x |> arpUp3 x--alberti3 :: Chord a -> Score a-alberti3 x = scat $ map ((^/16) . pure) [a,c,b,c]-  where-    [a,b,c] = unchord x----triad :: Transposable a => a -> Chord a-triad x = mconcat $ map pure [x, up _M3 x, up _P5 x]--mtriad :: Transposable a => a -> Chord a-mtriad x = mconcat $ map pure [x, up m3 x, up _P5 x]--sixthChord       = down m3 . invertC . mtriad-sixthFourthChord = down _P5 . invertC . invertC . triad----- TODO better parsing-fromBass :: Transposable a => String -> a -> Chord a-fromBass "" x = triad x--}

@@ -1,15 +1,14 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}  ------------------------------------------------------------------------------------- -- |@@ -34,27 +33,30 @@         stretchTo,   ) where -import           Music.Time.Transform- import           Control.Lens         hiding (Indexable, Level, above, below,                                        index, inside, parts, reversed,                                        transform, (<|), (|>)) import           Data.NumInstances    () import           Data.Semigroup       hiding () import           Data.VectorSpace     hiding (Sum (..))--- import           Data.Functor.Contravariant () +import           Music.Time.Transform+ -- | -- Class of values that have a duration. ----- Law Duration+-- Should satisfy -- -- @--- '_duration' x = ('offset' x '.-.' 'onset' x)+-- (transform s x)^.duration = transform s (x^.duration) -- @ -- class HasDuration a where++  -- | Return the duration of a value.   _duration :: a -> Duration++  {-# MINIMAL _duration #-}  instance HasDuration Duration where   _duration = id

@@ -1,18 +1,18 @@ +{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-} {-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE FlexibleContexts              #-}  ------------------------------------------------------------------------------------- -- |@@ -38,29 +38,31 @@   ) where  import           Control.Applicative-import           Control.Monad (join, mapM)-import           Data.Semigroup-import           Data.Functor.Couple-import           Data.Functor.Classes-import           Data.Functor.Compose-import           Control.Monad.Compose import           Control.Comonad-import           Data.Distributive (distribute) import           Control.Lens             hiding (Indexable, Level, above,                                            below, index, inside, parts,                                            reversed, transform, (<|), (|>))-import           Data.PairMonad-import           Data.String-import           Data.VectorSpace+import           Control.Monad            (join, mapM)+import           Control.Monad.Compose+import           Data.Distributive        (distribute) import           Data.Foldable            (Foldable) import qualified Data.Foldable            as Foldable+import           Data.Functor.Classes+import           Data.Functor.Compose+import           Data.Functor.Couple+import           Data.PairMonad+import           Data.Semigroup+import           Data.String import           Data.Typeable+import           Data.VectorSpace+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON  import           Music.Dynamics.Literal import           Music.Pitch.Literal-import           Music.Time.Internal.Util (through, tripped)-import           Music.Time.Reverse-import           Music.Time.Split++import           Music.Time.Internal.Util (dependingOn, through, tripped)+import           Music.Time.Juxtapose import           Music.Time.Meta  @@ -104,7 +106,7 @@   Compose a / Compose b = Compose (a / b)   fromRational = Compose . fromRational instance Floating (f (g a)) => Floating (Compose f g a) where-  + instance (Real (f (g a)), Ord1 f, Ord1 g, Ord a, Functor f) => Real (Compose f g a) where   -- TODO instance (RealFrac (f (g a)), Ord1 f, Ord1 g, Ord a, Functor f) => RealFrac (Compose f g a) where@@ -119,24 +121,8 @@ #endif  newtype Event a = Event { getEvent :: Compose AddMeta (Couple Span) a }-  deriving (-    Eq,-    Ord,-    Typeable,-    Foldable,-    Applicative,-    Monad,-    -- Comonad,-    Traversable,-    -    Functor,-    -    Num,-    Fractional,-    Floating,-    Real,-    RealFrac-    )  +  deriving (Eq, Ord, Typeable, Foldable, Applicative, Monad, {- Comonad, -} Traversable,+            Functor, Num, Fractional, Floating, Real, RealFrac)  instance Wrapped (Event a) where   type Unwrapped (Event a) = AddMeta (Span, a)@@ -171,11 +157,17 @@ instance (Show a, Transformable a) => Show (Event a) where   show x = show (x^.from event) ++ "^.event" +instance ToJSON a => ToJSON (Event a) where+  -- TODO meta+  toJSON a = JSON.object [ ("span", toJSON s), ("value", toJSON x) ]+    where+      (s, x) = a^.from event+ instance Comonad Event where   extract e   = e^.eventValue   duplicate e = set meta (e^.meta) $ (e^.eventSpan,e)^.event-   + -- | View a event as a pair of the original value and the transformation (and vice versa). event :: Iso (Span, a) (Span, b) (Event a) (Event b) event = from (_Wrapped . unsafeAnnotated)@@ -200,83 +192,3 @@ triple :: Iso (Event a) (Event b) (Time, Duration, a) (Time, Duration, b) triple = from event . bimapping delta id . tripped ---- TODO consolidate-dependingOn :: Lens s t (x,a) (x,b) -> (x -> Lens a b c d) -> Lens s t c d-dependingOn l depending f = l (\ (x,a) -> (x,) <$> depending x f a)------------ newtype AddMeta1 f a = AddMeta1 { getAddMeta1 :: Twain Meta (f a) }---   deriving (---     )--- --- instance Wrapped (AddMeta1 f a) where---   type Unwrapped (AddMeta1 f a) = Twain Meta (f a)---   _Wrapped' = iso getAddMeta1 AddMeta1--- --- instance Rewrapped (AddMeta1 f a) (AddMeta1 f b)--- --- instance HasMeta (AddMeta1 f a) where---   -- twain, pair, element---   meta = _Wrapped . _Wrapped . _1--- --- --- -- instance FunctorWithIndex i AddMeta1 where---   -- imap f = over annotated $ imap f--- -- --- -- instance FoldableWithIndex Span Score where--- --   ifoldMap f (Score (m,x)) = ifoldMap f x--- -- --- -- instance TraversableWithIndex Span Score where--- --   itraverse f (Score (m,x)) = fmap (\x -> Score (m,x)) $ itraverse f x--- --- instance Transformable (f a) => Transformable (AddMeta1 f a) where---   transform t = over meta (transform t) . over annotated1 (transform t)--- --- instance Reversible (f a) => Reversible (AddMeta1 f a) where---   rev = over meta rev . over annotated1 rev--- --- -- instance Splittable a => Splittable (AddMeta1 a) where--- --   split t = unzipR . fmap (split t)--- --- instance HasPosition (f a) => HasPosition (AddMeta1 f a) where---   _era = _era . extract---   _position = _position . extract--- --- instance HasDuration (f a) => HasDuration (AddMeta1 f a) where---   _duration = _duration . extract--- --- -- |--- -- Access the annotated value.--- ----- -- @--- -- over annotated = fmap--- -- @--- ----- annotated1 :: Lens (AddMeta1 f a) (AddMeta1 f b) (f a) (f b)--- annotated1 = unsafeAnnotated1--- --- -- |--- -- Access the annotated value.--- ----- -- @--- -- view fromAnnotated = pure--- -- @--- ----- unannotated1 :: Getter (f a) (AddMeta1 f a)--- unannotated1 = from unsafeAnnotated1--- --- unsafeAnnotated1 :: Iso (AddMeta1 f a) (AddMeta1 f b) (f a) (f b)--- unsafeAnnotated1 = _Wrapped . extracted--- --- unzipR f = (map fst f, map snd f)--- --- extracted :: (Applicative m, Comonad m) => Iso (m a) (m b) a b--- extracted = iso extract pure

@@ -15,5 +15,5 @@     module Music.Time.Past ) where --- Future and Past are defined together in this module for now. -import Music.Time.Past+-- Future and Past are defined together in this module for now.+import           Music.Time.Past

@@ -1,57 +0,0 @@--{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}------------------------------------------------------------------------------------------ |--- Copyright   : (c) Hans Hoglund 2012–2014------ License     : BSD-style------ Maintainer  : hans@hanshoglund.se--- Stability   : experimental--- Portability : non-portable (TF,GNTD)-------------------------------------------------------------------------------------------module Music.Time.Graces where--import           Control.Applicative-import           Control.Monad-import           Control.Monad.Compose-import           Control.Monad.Plus-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable-import           Data.Traversable       (Traversable)-import qualified Data.Traversable       as T-import           Data.Typeable--import Music.Time.Split-import Music.Time.Reverse-import Music.Time.Nominal-import Music.Time.Voice--newtype Graces f a = Graces { getGraces :: (Nominal f a, f a, Nominal f a) }-  deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable)---- TODO move-instance Alternative f => Alternative (Nominal f) where-  empty = Nominal empty-  Nominal a <|> Nominal b = Nominal (a <|> b)--instance (Applicative f, Alternative f) => Applicative (Graces f) where-  pure x = Graces (empty, pure x, empty)---- deriving instance Transformable a => Transformable (Graces a) where--- deriving instance Splittable a => Splittable (Graces a) where--- deriving instance Reversible a => Reversible (Graces a) where-

@@ -30,12 +30,14 @@   ) where  import           Control.Applicative-import           Control.Lens hiding (transform, time)+import           Control.Lens           hiding (time, transform) import           Control.Monad import           Control.Monad.Plus import           Data.AffineSpace import           Data.AffineSpace.Point import           Data.Foldable          (Foldable (..))+import qualified Data.Foldable          as Foldable+import qualified Data.List              as List import           Data.Ord import           Data.Ratio import           Data.Semigroup@@ -44,10 +46,6 @@ import           Data.VectorSpace  import           Music.Time--import qualified Data.Foldable          as Foldable-import qualified Data.List              as List-  reactiveToVoice' :: Span -> Reactive a -> Voice a reactiveToVoice' (view range -> (u,v)) r = (^. voice) $ fmap (^. note) $ durs `zip` (fmap (r `atTime`) times)

@@ -39,13 +39,9 @@         -- * Apply under a transformation         whilst,         whilstL,-        whilstL2,         whilstLT,         whilstLD,-        whilstStretch,-        whilstDelay,         onSpan,-        conjugateS,          -- * Specific transformations         -- ** Transformations@@ -63,26 +59,25 @@    ) where -import           Music.Time.Types--import           Data.Ratio- import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point-import           Data.Map               (Map)-import qualified Data.Map               as Map+import           Data.Map                 (Map)+import qualified Data.Map                 as Map+import           Data.Ratio import           Data.Semigroup import           Data.Semigroup.Instances ()-import           Data.Sequence          (Seq)-import qualified Data.Sequence          as Seq-import           Data.Set               (Set)-import qualified Data.Set               as Set-import           Data.VectorSpace       hiding (Sum (..))+import           Data.Sequence            (Seq)+import qualified Data.Sequence            as Seq+import           Data.Set                 (Set)+import qualified Data.Set                 as Set+import           Data.VectorSpace         hiding (Sum (..)) +import           Music.Time.Types+ -- Transformable laws: -- > transform mempty   = id -- > transform (s <> t) = transform s . transform t@@ -138,6 +133,9 @@ instance Transformable Span where   transform = (<>) +instance Transformable a => Transformable (Maybe a) where+  transform s = fmap (transform s)+ instance Transformable a => Transformable (Option a) where   transform s = fmap (transform s) @@ -294,19 +292,19 @@ From profunctor:   dimap ab cd bc = cd . bc . ab   dimap ab cd    = \f -> cd . f . ab-   + flip whilstM = transformed flip whilstM = \s -> iso (transform s) (itransform s) flip whilstM = \s -> dimap (transform s) (fmap $ itransform s) flip whilstM = \s f -> (fmap $ itransform s) . f . transform s flip (\f t -> fmap (transform (negateV t)) . f . transform t) = \s f -> (fmap $ itransform s) . f . transform s -\t f -> fmap (transform (negateV t)) . f . transform t +\t f -> fmap (transform (negateV t)) . f . transform t = \t f -> (fmap $ itransform t) . f . transform t -\t f -> fmap (itransform t) . f . transform t +\t f -> fmap (itransform t) . f . transform t = \t f -> fmap (itransform t) . f . transform t @@ -332,10 +330,10 @@   -dobar :: (Functor f) +dobar :: (Functor f) -  => -  (sp -> (s -> f t) -> (s -> f t)) +  =>+  (sp -> (s -> f t) -> (s -> f t))   -> ((s -> f t) -> a -> f b)   -> (s -> f t)  -> ((sp, a) -> f (sp, b)) @@ -394,7 +392,7 @@ -- l `onSpan` (2 \<-> 3) -- @ ---onSpan :: (Transformable s, Transformable t, Functor f) +onSpan :: (Transformable s, Transformable t, Functor f)   => LensLike f s t a b -> Span -> LensLike f s t a b f `onSpan` s = transformed (negateV s) . f -- TODO name

@@ -1,7 +1,7 @@ -{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes    #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns  #-}  ------------------------------------------------------------------------------------- -- |@@ -30,11 +30,12 @@   partial2,   partial3,   _zipList,+  dependingOn,   ) where  {-     Rules:-    +         * Functions may depend on any module in the lastest Haskell Platform release         * All functions but those in Prelude must be referred to with their full,           qualified names (i.e. Data.List.unfoldr).@@ -44,17 +45,17 @@             -- | Ordinary Haddock commentary ...             -- > category: Categories (please use the common Hackage names)             -- > depends : base (all packages in HP that the function depends on)-            + -} -import Control.Lens-import Control.Monad.Plus-import Control.Applicative+import           Control.Applicative+import           Control.Lens+import           Control.Monad.Plus import qualified Data.Char-import qualified Data.Monoid+import           Data.Functor.Contravariant (Equivalence (..), contramap) import qualified Data.List+import qualified Data.Monoid import qualified Data.Ratio-import Data.Functor.Contravariant (Equivalence(..), contramap)  -- | Divide a list into parts of maximum length n. -- > category : List@@ -101,7 +102,7 @@     where         n  = length as - 1         is = [0..n]-        + -- test  -- | Duplicate an element.@@ -110,7 +111,7 @@ dup :: a -> (a,a) dup x = (x,x) --- | Unfold a partial function. This is a simpler version of 'Data.List.unfoldr'. +-- | Unfold a partial function. This is a simpler version of 'Data.List.unfoldr'. -- > category: Function, List -- > depends: base unf :: (a -> Maybe a) -> a -> [a]@@ -149,8 +150,8 @@         go []    = []         go [a]   = [f a]         go [a,b] = [f a, h b]-        go xs    = [f $ head xs]          ++ -                   map g (tail $ init xs) ++ +        go xs    = [f $ head xs]          +++                   map g (tail $ init xs) ++                    [h $ last xs]  -- |@@ -189,7 +190,7 @@ rotated :: Int -> [a] -> [a] rotated = go     where-        go n as +        go n as             | n >= 0 = iterate rotr as !! n             | n <  0 = iterate rotl as !! abs n @@ -354,9 +355,9 @@ toDouble :: Real a => a -> Double toDouble = realToFrac -through :: Applicative f => -  Lens' s a -  -> Lens s t a b +through :: Applicative f =>+  Lens' s a+  -> Lens s t a b   -> Lens (f s) (f t) (f a) (f b) through lens1 lens2 = lens getter (flip setter)   where@@ -389,4 +390,7 @@ inspectingBy :: (b -> a) -> (a -> a -> Bool) -> (b -> b -> Bool) inspectingBy f e = getEquivalence $ contramap f $ Equivalence e -- inspectingBy f p x y = f x `p` f y++dependingOn :: Lens s t (x,a) (x,b) -> (x -> Lens a b c d) -> Lens s t c d+dependingOn l depending f = l (\ (x,a) -> (x,) <$> depending x f a) 

@@ -21,7 +21,10 @@ -------------------------------------------------------------------------------------  module Music.Time.Juxtapose (-       -- * Align without composition+        module Music.Time.Split,+        module Music.Time.Reverse,++        -- * Align without composition         lead,         follow, @@ -44,10 +47,9 @@         times,   ) where -import           Control.Lens hiding ((|>), (<|))+import           Control.Lens           hiding ((<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point--- import           Data.Monoid.WithSemigroup import           Data.Semigroup import           Data.VectorSpace @@ -55,16 +57,9 @@ import           Music.Time.Split  ------ TODO names--- Especially 'after' is counter-intuitive---- -- |--- Move a value so that--- -- @--- '_offset' (a `lead` b) = '_onset' b+-- (a `lead` b)^.'offset' = b^.'onset' -- @ -- --@@ -72,24 +67,16 @@ a `lead` b   = placeAt 1 (b `_position` 0) a  -- |--- Move a value so that--- -- @--- '_offset' a = '_onset' (a `follow` b)+-- a^.'offset' = (a `follow` b)^.'onset' -- @ -- follow :: (HasPosition a, HasPosition b, Transformable b) => a -> b -> b a `follow` b = placeAt 0 (a `_position` 1) b --- |--- Move a value so that--- after :: (Semigroup a, Transformable a, HasPosition a) => a -> a -> a a `after` b =  a <> (a `follow` b) --- |--- Move a value so that--- before :: (Semigroup a, Transformable a, HasPosition a) => a -> a -> a a `before` b =  (a `lead` b) <> b @@ -138,19 +125,11 @@ -- | -- Move a value so that its era is equal to the era of another value. ----- @--- 'Score' a -> 'Score' a -> 'Score' a--- @--- during :: (HasPosition a, HasPosition b, Transformable a, Transformable b) => a -> b -> a y `during` x = set era (view era x) y  -- | -- Like '<>', but scaling the second agument to the duration of the first.------ @--- 'Score' a -> 'Score' a -> 'Score' a--- @ -- sustain :: (Semigroup a, HasPosition a, Transformable a) => a -> a -> a x `sustain` y = x <> y `during` x

@@ -8,9 +8,9 @@ {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeOperators              #-} @@ -33,9 +33,9 @@         -- * Attributes         AttributeClass,         TAttributeClass,-        +         Attribute,-        +         -- ** Creating attributes         wrapAttr,         wrapTAttr,@@ -70,28 +70,25 @@  import           Control.Applicative import           Control.Comonad-import           Control.Lens              hiding (transform)+import           Control.Lens             hiding (transform) import           Control.Monad.Plus-import           Data.Functor.Rep -- TODO experimental-import           Data.Foldable             (Foldable)-import qualified Data.Foldable             as F-import qualified Data.List                 as List+import           Data.Foldable            (Foldable)+import qualified Data.Foldable            as F import           Data.Functor.Adjunction  (unzipR)-import           Data.Map                  (Map)-import qualified Data.Map                  as Map+import           Data.Functor.Couple+import           Data.Functor.Rep+import qualified Data.List                as List+import           Data.Map                 (Map)+import qualified Data.Map                 as Map import           Data.Maybe import           Data.Semigroup-import           Data.Set                  (Set)-import qualified Data.Set                  as Set+import           Data.Set                 (Set)+import qualified Data.Set                 as Set import           Data.String import           Data.Typeable--- import           Data.Void-import           Data.Functor.Couple  import           Music.Time.Internal.Util-import           Music.Time.Reverse-import           Music.Time.Split-import           Music.Time.Transform+import           Music.Time.Juxtapose  -- | Class of values that can be wrapped. type AttributeClass a = (Typeable a, Monoid a, Semigroup a)@@ -130,15 +127,12 @@   transform _ (Attribute a) = Attribute a   transform s (TAttribute a) = TAttribute (transform s a) -instance Splittable Attribute where-  split _ x = (x,x)- instance Reversible Attribute where   rev = id  -- Meta is Transformable because the contents of the map is transformable newtype Meta = Meta { _getMeta :: Map String Attribute }-  deriving (Transformable, Reversible, Splittable)+  deriving (Transformable, Reversible)  instance Semigroup Meta where   Meta s1 <> Meta s2 = Meta $ Map.unionWith (<>) s1 s2@@ -232,7 +226,7 @@ -- | -- Annotate an arbitrary type with meta-data, preserving instances of -- all common type classes. In particular 'Functor' and 'Applicative' is lifted and--- @'Compose' 'AddMeta'@ is semantically equivalent to 'Identity'. +-- @'Compose' 'AddMeta'@ is semantically equivalent to 'Identity'.  -- Meta-data is carried along with the annotated value. It defaults to 'mempty' -- in 'pure'. When composing values using '<*>', 'liftA2' etc, meta-data is composed@@ -244,12 +238,9 @@ -- You can access the meta-data using 'meta', and the annotated value using 'annotated'. -- newtype AddMeta a = AddMeta { getAddMeta :: Meta `Twain` a }-  deriving (-    Show, Functor, Foldable, Typeable, Applicative, Monad, Comonad,-    Semigroup, Monoid, Num, Fractional, Floating, Enum, Bounded,-    Integral, Real, RealFrac,-    Eq, Ord-    )+  deriving (Show, Functor, Foldable, Typeable, Applicative, Monad, Comonad,+            Semigroup, Monoid, Num, Fractional, Floating, Enum, Bounded,+            Integral, Real, RealFrac, Eq, Ord)  instance Wrapped (AddMeta a) where   type Unwrapped (AddMeta a) = Twain Meta a@@ -264,10 +255,10 @@  -- instance FunctorWithIndex i AddMeta where   -- imap f = over annotated $ imap f--- +-- -- instance FoldableWithIndex Span Score where --   ifoldMap f (Score (m,x)) = ifoldMap f x--- +-- -- instance TraversableWithIndex Span Score where --   itraverse f (Score (m,x)) = fmap (\x -> Score (m,x)) $ itraverse f x @@ -316,7 +307,7 @@ -- @ -- over annotated = fmap -- @--- +-- unsafeAnnotated :: Iso (AddMeta a) (AddMeta b) a b unsafeAnnotated = _Wrapped . extracted 

@@ -1,66 +0,0 @@--{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-}-{-# LANGUAGE DeriveFoldable             #-}-{-# LANGUAGE DeriveTraversable          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE StandaloneDeriving         #-}-{-# LANGUAGE TupleSections              #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}------------------------------------------------------------------------------------------ |--- Copyright   : (c) Hans Hoglund 2012–2014------ License     : BSD-style------ Maintainer  : hans@hanshoglund.se--- Stability   : experimental--- Portability : non-portable (TF,GNTD)-------------------------------------------------------------------------------------------module Music.Time.Nominal where--import           Control.Applicative-import           Control.Monad-import           Control.Monad.Compose-import           Control.Monad.Plus-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable-import           Data.Traversable       (Traversable)-import qualified Data.Traversable       as T-import           Data.Typeable--import Music.Time.Split-import Music.Time.Reverse--newtype Nominal f a = Nominal { getNominal :: f a }-  deriving (-  	Eq, -  	Ord,-  	Read, -  	Show, -  	Functor, -  	Foldable, -  	Traversable, -  	Monad-  )--instance Applicative f => Applicative (Nominal f) where-  pure = Nominal . pure-  Nominal f <*> Nominal x = Nominal (f <*> x)--instance Transformable (Nominal f a) where-  transform _ = id--instance Splittable (Nominal f a) where-  split _ x = (x,x)--instance Reversible (f a) => Reversible (Nominal f a) where-  rev (Nominal x) = Nominal (rev x)-

@@ -1,4 +1,5 @@ +{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveFoldable             #-} {-# LANGUAGE DeriveFunctor              #-}@@ -6,9 +7,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE TupleSections              #-}+{-# LANGUAGE ViewPatterns               #-}  ------------------------------------------------------------------------------------- -- |@@ -33,21 +35,23 @@   ) where  import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Data.Bifunctor-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable+import           Data.Foldable            (Foldable)+import qualified Data.Foldable            as Foldable import           Data.Functor.Couple import           Data.String import           Data.Typeable import           Data.VectorSpace+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON  import           Music.Dynamics.Literal import           Music.Pitch.Literal-import           Music.Time.Reverse-import           Music.Time.Split+import           Music.Time.Internal.Util (dependingOn)+import           Music.Time.Juxtapose   -- |@@ -59,24 +63,9 @@ -- value can still be delayed using @'fmap' 'delay'@. -- newtype Note a = Note { getNote :: Duration `Couple` a }-  deriving (-    Eq,-    Ord,-    Typeable,-    Foldable,-    Traversable,--    Functor,-    Applicative,-    Monad,--    Num,-    Fractional,-    Floating,-    Real,-    RealFrac-    )-            -- Comonad,+  deriving (Eq, Ord, Typeable, Foldable, Traversable,+            Functor, Applicative, Monad,+            Num, Fractional, Floating, Real, RealFrac)  instance (Show a, Transformable a) => Show (Note a) where   show x = show (x^.from note) ++ "^.note"@@ -93,6 +82,86 @@ instance HasDuration (Note a) where   _duration = _duration . view (from note) +{-+  Splitting a note is surprisingly difficult because of the recursive nature of split.+  +  In brief, when splitting (d,(x,a)^.note)^.note at t, we have to split the inner value x at (t/d),+  and then scale the results xa and xb by some values p and q such that the duration of the new+  nested notes (da*xa) and (db*xb) is the duration of the original nested note (d*x), as stated+  by the Splittable laws.+  +  Full derivation below.+  +  -----+  +  split t d = (da+db)+  split (t/d) x = (xa*p+xb*q)+  split t (d*x) = (da*xa+db*xb)+  +  d = da+db         [split laws]+  x = (xa*p+xb*q)   [split laws]+  d*x = da*xa+db*xb [split laws]+  +  Isolate p and q!++  xa*p + xb*q = x+  xa*p = x - xb*q+  p = (x - xb*q)/xa++  xa*p + xb*q = x+  xb*q = x - xa*p+  q = (x - xa*p)/xb+  +  -- Assuming we know t, d, x, xa*p, xb*q, da*xa, db*xb+  xa = da*xa/da+  xb = db*xb/db++  -- Example+  t = 0.6, d = 1, x = 2+  da = 0.6, db = 0.4+    [split t d]+  xa*p = 3/5, xb*q = 7/5,+    [split (t/d) x]+  da*xa = 3/5, db*xb = 7/5+    [split t (d*x)]++  xb = (7/5)/0.4 = 3.5+    [db*xb/db = xb]+  xa = (3/5)/0.6 = 1+    [da*xa/da = xa]+  +  p = (2 - 7/5) / 1 = 0.6  +    [p def]+  q = (2 - 3/5) / 3.5 = 0.4+    [q def]+  +  >>> split 0.6 (1,(2,_)^.note)^.note -- 2+            ( (0.6,(1,a)^.note)^.note                 -- da*xa+            , (0.4,(3.5,mempty)^.note)^.note            -- db*xb+  +-}+instance (Splittable a, Transformable a) => Splittable (Note a) where+  split t ((^.from note) -> (d, x)) = over both (^.note) $ split' t d x++split' :: (Transformable a, Splittable a) => Duration -> Duration -> a -> ((Duration, a), (Duration, a))+split' t d x  = ((da, compress p xa_p), (db, compress q xb_q))+  -- We are really returning ((da, xa), (db, xb))+  -- However because of the polymorphic value, we must derive xa and xb from split (t/d) x, p and q+  where+    -- (da+db)       = split t d+    -- (xa*p+xb*q)   = split (t/d) x+    -- (da*xa+db*xb) = split t (d*x)+    (da,db)        = split t d+    (xa_p, xb_q)   = split (t/d) x+    (da_xa, db_xb) = split t (d*(x^.duration))++    xa = da_xa/da+    xb = db_xb/db++    p = ((x^.duration) - (xb_q^.duration))/xa+    q = ((x^.duration) - (xa_p^.duration))/xb   ++ instance IsString a => IsString (Note a) where   fromString = pure . fromString @@ -105,6 +174,12 @@ instance IsDynamics a => IsDynamics (Note a) where   fromDynamics = pure . fromDynamics +instance ToJSON a => ToJSON (Note a) where+  -- TODO meta+  toJSON a = JSON.object [ ("duration", toJSON d), ("value", toJSON x) ]+    where+      (d, x) = a^.from note+ -- | View a note value as a pair of the original value and a stretch factor. note :: Iso (Duration, a) (Duration, b) (Note a) (Note b) note = _Unwrapped@@ -142,13 +217,4 @@  -- FIXME negateV is negate not recip -- The negateV method should follow (^+^), which is (*) for durations (is this bad?)----- TODO consolidate-dependingOn :: Lens s t (x,a) (x,b) -> (x -> Lens a b c d) -> Lens s t c d-dependingOn l depending f = l (\ (x,a) -> (x,) <$> depending x f a)---- 

@@ -1,9 +1,9 @@ -{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ViewPatterns               #-}-{-# LANGUAGE CPP #-}  module Music.Time.Past (         Past(..),@@ -16,21 +16,20 @@         futureSeg,   ) where -import Control.Lens -- DEBUG import           Control.Applicative import           Control.Comonad+import           Control.Lens+import           Control.Monad import           Data.Functor.Couple-import           Data.Ord            (comparing)-import           Data.List           (takeWhile, sort, sortBy, group)+import           Data.List            (group, sort, sortBy, takeWhile) import           Data.List.Ordered import           Data.Maybe+import           Data.Ord             (comparing) import           Data.Semigroup-import           Control.Monad  import           Music.Time.Behavior-import           Music.Time.Reverse+import           Music.Time.Juxtapose import           Music.Time.Segment-import           Music.Time.Split  -- | -- 'Past' represents a value occuring /before and at/ some point in time.@@ -50,13 +49,13 @@  -- instance HasDuration (Past a) where --   _duration _ = 0--- +-- -- instance HasDuration (Future a) where --   _duration _ = 0--- +-- -- instance HasPosition (Past a) where --   _position (Past ((extract . extract) -> t,_)) _ = t--- +-- -- instance HasPosition (Future a) where   -- _position (Future (extract -> t,_)) _ = t 

@@ -5,10 +5,10 @@ {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}  ------------------------------------------------------------------------------------- -- |@@ -33,15 +33,15 @@  import           Control.Applicative import           Control.Comonad-import           Control.Lens            hiding (Indexable, Level, above, below,-                                          index, inside, parts, reversed,-                                          transform, (<|), (|>))+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point import           Data.Bifunctor-import           Data.Foldable           (Foldable)-import qualified Data.Foldable           as Foldable-import           Data.Functor.Adjunction (unzipR)+import           Data.Foldable            (Foldable)+import qualified Data.Foldable            as Foldable+import           Data.Functor.Adjunction  (unzipR) import           Data.Functor.Couple import           Data.String import           Data.Typeable@@ -49,8 +49,8 @@  import           Music.Dynamics.Literal import           Music.Pitch.Literal-import           Music.Time.Reverse-import           Music.Time.Split+import           Music.Time.Internal.Util (dependingOn)+import           Music.Time.Juxtapose   -- |@@ -63,18 +63,8 @@ -- contrast to a note the /duration/ is not stretched. -- newtype Placed a = Placed { getPlaced :: Time `Couple` a }-  deriving (-    Eq,-    Ord,-    Typeable,-    Foldable,-    Traversable,-    -    Functor,-    Applicative,-    Monad,-    Comonad    -    )+  deriving (Eq, Ord, Typeable, Foldable, Traversable,+            Functor, Applicative, Monad, Comonad)  instance (Show a, Transformable a) => Show (Placed a) where   show x = show (x^.from placed) ++ "^.placed"@@ -86,9 +76,9 @@ instance Rewrapped (Placed a) (Placed b)  instance Transformable a => Transformable (Placed a) where-  transform t = -    over (from placed . _1) (transform t) -    . +  transform t =+    over (from placed . _1) (transform t)+    .     over (from placed . _2) (stretch $ stretchComponent t)  instance IsString a => IsString (Placed a) where@@ -111,6 +101,3 @@   where     delayingTime = (>-> 1) --- TODO consolidate-dependingOn :: Lens s t (x,a) (x,b) -> (x -> Lens a b c d) -> Lens s t c d-dependingOn l depending f = l (\ (x,a) -> (x,) <$> depending x f a)

@@ -1,8 +1,9 @@ +{-# LANGUAGE CPP                        #-} {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -10,8 +11,6 @@ {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}-{-# LANGUAGE CPP                        #-}  ------------------------------------------------------------------------------------- -- |@@ -34,13 +33,9 @@       -- * The HasPosition class       HasPosition(..), -      -- * Era-      era,-      _onset,-      _offset,--      -- * Position+      -- * Position and Era       position,+      era,        -- ** Specific positions       onset,@@ -55,6 +50,7 @@       stopAt,       placeAt, +      -- * Transforming relative a position       stretchRelative,       stretchRelativeOnset,       stretchRelativeMidpoint,@@ -72,22 +68,22 @@   ) where  +import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point-import           Data.Map               (Map)-import qualified Data.Map               as Map+import           Data.Map                 (Map)+import qualified Data.Map                 as Map import           Data.Semigroup-import           Data.Set               (Set)-import qualified Data.Set               as Set-import           Data.VectorSpace       hiding (Sum)+import           Data.Set                 (Set)+import qualified Data.Set                 as Set+import           Data.VectorSpace         hiding (Sum) + import           Music.Time.Duration import           Music.Time.Internal.Util -import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))- -- | -- Class of values that have a position in time. --@@ -97,39 +93,40 @@ -- a /global/ position. While the local position goes from 0 to 1, the global position -- goes from the 'onset' to the 'offset' of the value. ----- For instantaneous values, a suitable instance is:------ @--- '_position' x = 'const' t--- @------ For values with an onset and offset we can use 'alerp':+-- Should satisfy -- -- @--- '_position' x = 'alerp' ('_onset' x) ('_offset' x)+-- x^.duration   = x^.era.duration+-- x^.position n = x^.era.position n+-- (transform s x)^.era = transform s (x^.era) -- @ -- class HasDuration a => HasPosition a where +  -- | Map a local time in value to global time.   _position :: a -> Duration -> Time   _position x = alerp a b where (a, b) = (_era x)^.range +  -- | Return the conventional bounds of a value (local time 0 and 1).   _era :: HasPosition a => a -> Span   _era x = x `_position` 0 <-> x `_position` 1-  ++  {-# MINIMAL (_position | _era) #-}+ instance HasPosition Span where   _era = id  #ifndef GHCI-instance (HasPosition a, HasDuration a) => HasDuration [a] where+instance (HasPosition a, Transformable a) => HasDuration [a] where   _duration x = _offset x .-. _onset x -instance (HasPosition a, HasDuration a) => HasPosition [a] where+instance (HasPosition a, Transformable a) => HasPosition [a] where   _era x = (f x, g x)^.from range     where       f  = foldr min 0 . fmap _onset       g = foldr max 0 . fmap _offset #endif+#line 123  -- | -- Position of the given value.@@ -183,13 +180,13 @@ -- Move a value forward in time. -- startAt :: (Transformable a, HasPosition a) => Time -> a -> a-startAt t x = (t .-. _onset x) `delay` x+startAt t x = (t .-. x^.onset) `delay` x  -- | -- Move a value forward in time. -- stopAt  :: (Transformable a, HasPosition a) => Time -> a -> a-stopAt t x = (t .-. _offset x) `delay` x+stopAt t x = (t .-. x^.offset) `delay` x  -- | -- Align a value to a given position.@@ -204,7 +201,7 @@ placeAt :: (Transformable a, HasPosition a) => Duration -> Time -> a -> a placeAt p t x = (t .-. x `_position` p) `delay` x -_onset, _offset :: HasPosition a => a -> Time+_onset, _offset :: (HasPosition a, Transformable a) => a -> Time _onset     = (`_position` 0) _offset    = (`_position` 1.0) @@ -246,7 +243,6 @@  delayRelativeOffset :: (HasPosition a, Transformable a) => Duration -> a -> a delayRelativeOffset = delayRelative 1-  transformRelative :: (HasPosition a, Transformable a) => Duration -> Span -> a -> a transformRelative p n x = over (transformed $ undelaying (realToFrac $ x^.position p)) (transform n) x

@@ -1,8 +1,8 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -37,7 +37,7 @@         atTime,          -- * Construction-      +         -- * Combine         switchR,         trimR,@@ -51,7 +51,7 @@         sample,         -- TODO         -- window,-        -- windowed,   +        -- windowed,    ) where @@ -65,18 +65,6 @@ -- TODO integrate better in the library -- -import           Music.Time.Behavior-import           Music.Time.Bound-import           Music.Time.Event-import           Music.Time.Reverse-import           Music.Time.Segment-import           Music.Time.Split--import           Music.Pitch.Alterable-import           Music.Pitch.Augmentable-import           Music.Pitch.Literal-- import           Control.Applicative import           Control.Lens            hiding (Indexable, Level, above, below,                                           index, inside, parts, reversed,@@ -89,9 +77,19 @@ import qualified Data.List               as List import           Data.Semigroup          hiding () import           Data.Typeable+ import           Music.Dynamics.Literal+import           Music.Pitch.Alterable+import           Music.Pitch.Augmentable import           Music.Pitch.Literal+import           Music.Pitch.Literal +import           Music.Time.Behavior+import           Music.Time.Bound+import           Music.Time.Event+import           Music.Time.Juxtapose+import           Music.Time.Segment+ -- | -- Forms an applicative as per 'Behavior', but only switches at discrete points. --@@ -128,7 +126,7 @@     pure  = pureDefault       where         pureDefault = view _Unwrapped . pure . pure-        +     (<*>) = apDefault       where         (view _Wrapped -> (tf, rf)) `apDefault` (view _Wrapped -> (tx, rx)) = view _Unwrapped (tf <> tx, rf <*> rx)

@@ -37,8 +37,7 @@   ) where  import           Control.Applicative-import           Music.Time.Reverse-import           Music.Time.Split+import           Music.Time.Juxtapose  rest :: Applicative f => f (Maybe a) rest = pure Nothing

@@ -1,15 +1,14 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}  ------------------------------------------------------------------------------------- -- |@@ -39,31 +38,30 @@         NoReverse(..),   ) where -import           Data.AffineSpace-import           Data.AffineSpace.Point-import           Data.Map               (Map)-import qualified Data.Map               as Map-import           Data.Ratio-import           Data.Semigroup-import           Data.Set               (Set)-import qualified Data.Set               as Set-import           Data.VectorSpace--import           Music.Time.Position- import           Control.Lens           hiding (Indexable, Level, above, below,                                          index, inside, parts, reversed,                                          transform, (<|), (|>)) import           Data.AffineSpace+import           Data.AffineSpace import           Data.AffineSpace.Point+import           Data.AffineSpace.Point import           Data.Map               (Map)+import           Data.Map               (Map) import qualified Data.Map               as Map+import qualified Data.Map               as Map+import           Data.Ratio+import           Data.Semigroup import           Data.Semigroup         hiding () import           Data.Sequence          (Seq) import qualified Data.Sequence          as Seq+import           Data.Set               (Set)+import qualified Data.Set               as Set import           Data.Typeable+import           Data.VectorSpace import           Data.VectorSpace       hiding (Sum (..)) +import           Music.Time.Position+ -- | -- Class of values that can be reversed (retrograded). --@@ -81,7 +79,7 @@ -- @ -- -- @--- 'abs' ('_duration' x) = _duration ('rev' x)+-- 'abs' (x^.'duration') = ('rev' x)^.'duration' -- @ -- -- @

@@ -1,8 +1,9 @@ +{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -52,57 +53,56 @@         -- * Normalize         normalizeScore,         removeRests,-        +         -- * Utility         printEras,          -- * Unsafe versions         unsafeEvents,         unsafeTriples,-        -  ) where -import           Data.AffineSpace-import           Data.AffineSpace.Point-import qualified Data.List.NonEmpty     as NonEmpty-import           Data.Map               (Map)-import qualified Data.Map               as Map-import           Data.Ratio-import           Data.Semigroup-import           Data.Set               (Set)-import qualified Data.Set               as Set-import           Data.VectorSpace-import           Data.String-import           Data.Functor.Adjunction  (unzipR)--import           Music.Time.Juxtapose   (scat)-import           Music.Time.Meta-import           Music.Time.Event-import           Music.Time.Reverse-import           Music.Time.Split-import           Music.Time.Note-import           Music.Time.Voice+  ) where  import           Control.Applicative import           Control.Comonad-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Control.Monad import           Control.Monad.Compose import           Control.Monad.Plus-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable-import qualified Data.List              as List-import qualified Data.Ord               as Ord-import           Data.Semigroup         hiding ()-import           Data.Traversable       (Traversable)-import qualified Data.Traversable       as T+import           Data.AffineSpace+import           Data.AffineSpace.Point+import           Data.Foldable            (Foldable)+import qualified Data.Foldable            as Foldable+import           Data.Functor.Adjunction  (unzipR)+import qualified Data.List                as List+import qualified Data.List.NonEmpty       as NonEmpty+import           Data.Map                 (Map)+import qualified Data.Map                 as Map+import qualified Data.Ord                 as Ord+import           Data.Ratio+import           Data.Semigroup+import           Data.Semigroup           hiding ()+import           Data.Set                 (Set)+import qualified Data.Set                 as Set+import           Data.String+import           Data.Traversable         (Traversable)+import qualified Data.Traversable         as T import           Data.Typeable-import           Data.VectorSpace       hiding (Sum (..))+import           Data.VectorSpace+import           Data.VectorSpace         hiding (Sum (..))+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON+ import           Music.Dynamics.Literal import           Music.Pitch.Literal+import           Music.Time.Event import           Music.Time.Internal.Util+import           Music.Time.Juxtapose+import           Music.Time.Meta+import           Music.Time.Note+import           Music.Time.Voice   @@ -167,6 +167,12 @@   itraverse f (Score (m,x)) = fmap (\x -> Score (m,x)) $ itraverse f x -} +instance ToJSON a => ToJSON (Score a) where+  -- TODO meta+  toJSON x = JSON.object [ ("events", toJSON es) ]+    where+      es = x^.events+ instance Transformable (Score a) where   transform t (Score (m,x)) = Score (transform t m, transform t x) @@ -185,7 +191,7 @@   -- TODO clean up in terms of AddMeta and optimize  instance HasDuration (Score a) where-  _duration x = _offset x .-. _onset x+  _duration x = (^.offset) x .-. (^.onset) x   @@ -208,15 +214,15 @@   toEnum = return . toEnum   fromEnum = list 0 (fromEnum . head) . Foldable.toList --- Bogus instance, so we can use numeric literals instance Num a => Num (Score a) where   fromInteger = return . fromInteger   abs    = fmap abs   signum = fmap signum-  (+)    = error "Not implemented"-  (-)    = error "Not implemented"-  (*)    = error "Not implemented"+  (+)    = liftA2 (+)+  (-)    = liftA2 (-)+  (*)    = liftA2 (*) +{- -- Bogus instances, so we can use c^*2 etc. instance AdditiveGroup (Score a) where   zeroV   = error "Not implemented"@@ -226,6 +232,7 @@ instance VectorSpace (Score a) where   type Scalar (Score a) = Duration   d *^ s = d `stretch` s+-}  instance HasMeta (Score a) where   meta = _Wrapped . _1@@ -273,13 +280,13 @@ instance HasPosition (Score' a) where   _era x = (f x, g x)^.from range     where-      f = safeMinimum . fmap (_onset  . normalizeSpan) . toListOf (_Wrapped . each . era)-      g = safeMaximum . fmap (_offset . normalizeSpan) . toListOf (_Wrapped . each . era)+      f = safeMinimum . fmap ((^.onset)  . normalizeSpan) . toListOf (_Wrapped . each . era)+      g = safeMaximum . fmap ((^.offset) . normalizeSpan) . toListOf (_Wrapped . each . era)       safeMinimum xs = if null xs then 0 else minimum xs       safeMaximum xs = if null xs then 0 else maximum xs  instance HasDuration (Score' a) where-  _duration x = _offset x .-. _onset x+  _duration x = (^.offset) x .-. (^.onset) x  -- | Create a score from a list of events. score :: Getter [Event a] (Score a)@@ -291,7 +298,7 @@ events = _Wrapped . _2 . _Wrapped . sorted   where     -- TODO should not have to sort...-    sorted = iso (List.sortBy (Ord.comparing _onset)) (List.sortBy (Ord.comparing _onset))+    sorted = iso (List.sortBy (Ord.comparing (^.onset))) (List.sortBy (Ord.comparing (^.onset))) {-# INLINE events #-}  --@@ -323,7 +330,7 @@ -- 'toListOf' ('events' . 'each')                :: 'Score' a -> ['Event' a] -- 'toListOf' ('events' . 'elements' odd)        :: 'Score' a -> ['Event' a] -- 'toListOf' ('events' . 'each' . 'filtered'---              (\\x -> '_duration' x \< 2))  :: 'Score' a -> ['Event' a]+--              (\\x -> x^.'duration' \< 2))  :: 'Score' a -> ['Event' a] -- @  -- | A score is a list of events up to meta-data. To preserve meta-data, use the more@@ -331,7 +338,7 @@ unsafeEvents :: Iso (Score a) (Score b) [Event a] [Event b] unsafeEvents = _Wrapped . noMeta . _Wrapped . sorted   where-    sorted = iso (List.sortBy (Ord.comparing _onset)) (List.sortBy (Ord.comparing _onset))+    sorted = iso (List.sortBy (Ord.comparing (^.onset))) (List.sortBy (Ord.comparing (^.onset)))     noMeta = iso extract return  -- | A score is a list of (time-duration-value triples) up to meta-data.@@ -351,7 +358,7 @@       Foldable.toList .       fmap (view $ from event) .       reifyScore-    + -- | Map with the associated time span. mapScore :: (Event a -> b) -> Score a -> Score b mapScore f = over (_Wrapped._2) (mapScore' f)@@ -363,7 +370,7 @@  -- | View a score as a list of time-duration-value triplets. triples :: {-Transformable a => -}Lens (Score a) (Score b) [(Time, Duration, a)] [(Time, Duration, b)]-triples = events . _zipList . through triple triple . from _zipList+triples = unsafeTriples   -- | Map over the values in a score.

@@ -1,8 +1,8 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -70,55 +70,53 @@          -- * Bound type         Bound,-        -- * Query        +        -- * Query         bounds,         bounding,         -- * Combine         trim,         splice,         bounded',-        bounded,     +        bounded,    ) where +import           Control.Applicative+import           Control.Lens           hiding (Indexable, Level, above, below,+                                         index, inside, parts, reversed,+                                         transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point import           Data.Clipped+import           Data.Distributive+import           Data.Functor.Rep       as R+import           Data.Functor.Rep.Lens import           Data.Map               (Map) import qualified Data.Map               as Map+import           Data.Maybe import           Data.Ratio import           Data.Semigroup import           Data.Set               (Set) import qualified Data.Set               as Set+import           Data.Typeable import           Data.VectorSpace +import           Music.Dynamics.Literal+import           Music.Pitch.Literal import           Music.Time.Behavior import           Music.Time.Bound import           Music.Time.Event-import           Music.Time.Reverse-import           Music.Time.Score-import           Music.Time.Split+import           Music.Time.Juxtapose import           Music.Time.Note+import           Music.Time.Score import           Music.Time.Voice -import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))-import           Data.Distributive-import           Data.Functor.Rep as R-import           Data.Functor.Rep.Lens-import           Data.Maybe-import           Data.Typeable-import           Music.Dynamics.Literal-import           Music.Pitch.Literal - -- TODO Compare Diagram's Trail and Located (and see the conal blog post)  -- | ----- A 'Segment' is a value varying over some unknown time span. +-- A 'Segment' is a value varying over some unknown time span. -- Intuitively, a 'Segment' is to a 'Behavior' what a /ray/ is to a /line/. -- -- To give a segment an explicit duration, use 'Event' 'Segment'.@@ -299,7 +297,7 @@ -- -- @ -- 'trim'   = 'splice' 'mempty'--- 'trim' x = 'trimBefore' '_onset' x . 'trimAfter' '_offset' x+-- 'trim' x = 'trimBefore' (x^.'onset') . 'trimAfter' (x^.'offset') -- @ -- trim :: Monoid b => Bound (Behavior b) -> Behavior b

@@ -1,8 +1,8 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -31,28 +31,28 @@         Splittable(..),          -- * Miscellaneous-        splitAbs,+        -- splitAbs,         chunks,    ) where -import           Music.Time.Position-import           Music.Time.Internal.Util--import           Control.Lens            hiding (Indexable, Level, above, below,-                                          index, inside, parts, reversed,-                                          transform, (<|), (|>))+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>)) import           Data.AffineSpace import           Data.AffineSpace.Point-import           Data.Functor.Adjunction (unzipR)+import           Data.Functor.Adjunction  (unzipR) import           Data.Functor.Rep-import           Data.Map                (Map)-import qualified Data.Map                as Map-import           Data.Semigroup          hiding ()-import           Data.Sequence           (Seq)-import qualified Data.Sequence           as Seq-import           Data.VectorSpace        hiding (Sum (..))+import           Data.Map                 (Map)+import qualified Data.Map                 as Map+import           Data.Semigroup           hiding ()+import           Data.Sequence            (Seq)+import qualified Data.Sequence            as Seq+import           Data.VectorSpace         hiding (Sum (..)) +import           Music.Time.Internal.Util+import           Music.Time.Position+ -- | -- Class of values that can be split. --@@ -66,9 +66,12 @@ -- Law -- -- @--- '_duration' ('beginning' t x) + '_duration' ('ending' t x) = '_duration' x--- '_duration' ('beginning' t x) = t `min` '_duration' x                    iff t >= 0--- '_duration' ('ending' t x)    = '_duration' x - (t `min` '_duration' x)    iff t >= 0+-- ('beginning' t x)^.'duration' + ('ending' t x)^.'duration' = x^.'duration'+--+-- ('beginning' t x)^.'duration' = t `min` x^.'duration'                    iff t >= 0+--+-- ('ending' t x)^.'duration'    = x^.'duration' - (t `min` x^.'duration')    iff t >= 0+-- -- @ -- -- (Note that any of these three laws can be derived from the other two, so it is@@ -80,7 +83,7 @@ -- >>> (\x -> fmap (flip split x) [-2,-1,0,0.5,1,2]) $ (0<->1) -- [(0 <-> 0,0 <-> 1),(0 <-> 0,0 <-> 1),(0 <-> 0,0 <-> 1),(0 <-> (1/2),(1/2) <-> 1),(0 <-> 1,1 <-> 1),(0 <-> 1,1 <-> 1)] ---class Splittable a where+class HasDuration a => Splittable a where   split      :: Duration -> a -> (a, a)   beginning  :: Duration -> a -> a   ending     :: Duration -> a -> a@@ -89,6 +92,9 @@   ending    d = snd . split d -- TODO rename beginning/ending to fstSplit/sndSplit or similar +instance HasDuration () where+  _duration () = 1+ instance Splittable () where   split _ x = (x, x) @@ -98,27 +104,18 @@   split t x = (t' `min` x, x ^-^ (t' `min` x))     where t' = t `max` 0 -instance Splittable Span where-  -- Splitting a span splits the duration-  split pos (view delta -> (t, d)) = (t >-> d1, (t .+^ d1) >-> d2)-    where (d1, d2) = split pos d--instance (Ord k, Splittable a) => Splittable (Map k a) where-  split d = unzipR . Map.map (split d)-- -- takeMWhile :: (Monoid a, HasDuration a, Splittable a) => Duration -> (a -> Bool) -> a -> a--- takeMWhile d p xs = if _duration xs <= 0 then mempty else takeMWhile' d p xs+-- takeMWhile d p xs = if xs^.'duration' <= 0 then mempty else takeMWhile' d p xs --   where --     takeMWhile' d p (split d -> (x, xs)) = if p x then x `mappend` takeMWhile d p xs else mempty -chunks :: (Splittable a, HasDuration a) => Duration -> a -> [a]-chunks d xs = if _duration xs <= 0 then [] else chunks' d xs+chunks :: (Splittable a, HasDuration a, Transformable a) => Duration -> a -> [a]+chunks d xs = if xs^.duration <= 0 then [] else chunks' d xs   where     chunks' d (split d -> (x, xs)) = [x] ++ chunks d xs  -splitAbs :: (HasPosition a, Splittable a) => Time -> a -> (a, a)-splitAbs t x = split (t .-. _onset x) x+splitAbs :: (HasPosition a, Transformable a, Splittable a) => Time -> a -> (a, a)+splitAbs t x = split (t .-. x^.onset) x  

@@ -1,15 +1,14 @@  {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE StandaloneDeriving         #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE ViewPatterns               #-}  ------------------------------------------------------------------------------------- -- |@@ -36,34 +35,32 @@   ) where  +import           Control.Applicative+import           Control.Lens             hiding (Indexable, Level, above,+                                           below, index, inside, parts,+                                           reversed, transform, (<|), (|>))+import           Control.Monad+import           Control.Monad.Compose+import           Control.Monad.Plus import           Data.AffineSpace import           Data.AffineSpace.Point-import           Data.Map               (Map)-import qualified Data.Map               as Map+import           Data.Foldable            (Foldable)+import qualified Data.Foldable            as Foldable+import           Data.Map                 (Map)+import qualified Data.Map                 as Map import           Data.Ratio import           Data.Semigroup-import           Data.Set               (Set)-import qualified Data.Set               as Set+import           Data.Set                 (Set)+import qualified Data.Set                 as Set+import           Data.Traversable         (Traversable)+import qualified Data.Traversable         as T+import           Data.Typeable import           Data.VectorSpace+import           Music.Time.Internal.Util +import           Music.Time.Juxtapose import           Music.Time.Placed-import           Music.Time.Reverse-import           Music.Time.Split -import           Control.Applicative-import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>))-import           Control.Monad-import           Control.Monad.Compose-import           Control.Monad.Plus-import           Data.Foldable          (Foldable)-import qualified Data.Foldable          as Foldable-import           Data.Traversable       (Traversable)-import qualified Data.Traversable       as T-import           Data.Typeable-import           Music.Time.Internal.Util- -- | -- A 'Track' is a parallel composition of values. newtype Track a = Track { getTrack :: TrackList (TrackEv a) }@@ -116,13 +113,6 @@  instance Transformable a => Transformable (Track a) where   transform s = over _Wrapped' (transform s)---- instance Splittable a => Splittable (Track a) where---   -- TODO---- instance Reversible a => Reversible (Track a) where---   -- TODO-  -- | Create a track from a list of notes. track :: Getter [Placed a] (Track a)

@@ -48,9 +48,19 @@         undelay,         stretch,         compress,+        (|*),+        (*|),+        (|/),    ) where  import           Music.Time.Internal.Transform import           Music.Time.Types +infixl 7 |*+infixr 7 *|+infixr 7 |/++x |* d = stretch d x+d *| x = stretch d x+x |/ d = compress d x 

@@ -1,5 +1,4 @@ -{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE ConstraintKinds            #-} {-# LANGUAGE DeriveDataTypeable         #-} {-# LANGUAGE DeriveFoldable             #-}@@ -10,6 +9,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-} {-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}@@ -35,12 +35,12 @@         -- * Basic types         Time,         Duration,+        Alignment,+                 LocalDuration,          -- ** Convert between time and duration         -- $convert-        offsetPoints,-        pointOffsets,         toAbsoluteTime,         toRelativeTime,         toRelativeTimeN,@@ -67,11 +67,11 @@         normalizeSpan,         reverseSpan,         reflectSpan,-        +         -- ** Properties         isEmptySpan,         isForwardSpan,-        isBackwardSpan,        +        isBackwardSpan,          -- delayComponent,         -- stretchComponent,@@ -94,18 +94,18 @@         strictlyAfterOffset,         beforeOffset,         strictlyBeforeOffset,-        +         startsWhenStarts,         startsWhenStops,         stopsWhenStops,         stopsWhenStarts,-        +         startsBefore,         startsLater,         stopsAtTheSameTime,         stopsBefore,         stopsLater,-        +         -- union         -- intersection (alt name 'overlap')         -- difference (would actually become a split)@@ -116,21 +116,23 @@         showCodelta,   ) where -import           Control.Lens           hiding (Indexable, Level, above, below,-                                         index, inside, parts, reversed,-                                         transform, (<|), (|>)) import           Control.Applicative.Backwards+import           Control.Lens                  hiding (Indexable, Level, above,+                                                below, index, inside, parts,+                                                reversed, transform, (<|), (|>)) import           Control.Monad.State.Lazy-import           Data.Aeson (ToJSON(..))-import qualified Data.Aeson as JSON+import           Data.AffineSpace.Point.Offsets+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON import           Data.AffineSpace import           Data.AffineSpace.Point+import           Data.List                     (mapAccumL, mapAccumR)+import           Data.Ratio import           Data.Semigroup import           Data.Typeable import           Data.VectorSpace-import           Data.List (mapAccumL, mapAccumR)-import           Data.Ratio-import           Music.Time.Internal.Util (showRatio)++import           Music.Time.Internal.Util      (showRatio) -- import           Data.Fixed  -- $convert@@ -159,25 +161,18 @@ deriving instance Floating Duration -} -type LocalDuration = Duration+type Alignment     = Duration +type LocalDuration = Alignment+{-# DEPRECATED LocalDuration "Use 'Alignment'"#-} + -- | -- Duration, corresponding to note values in standard notation. -- The standard names can be used: @1\/2@ for half note @1\/4@ for a quarter note and so on. -- newtype Duration = Duration { getDuration :: TimeBase }-  deriving (-    Eq,-    Ord,-    Typeable,-    Enum,-    -    Num,-    Fractional,-    Real,-    RealFrac-    )+  deriving (Eq, Ord, Typeable, Enum, Num, Fractional, Real, RealFrac)  -- Duration is a one-dimensional 'VectorSpace', and is the associated vector space of time points. -- It is a also an 'AdditiveGroup' (and hence also 'Monoid' and 'Semigroup') under addition.@@ -220,17 +215,7 @@ -- infinite, or contain a musical pickup. Hence 'Time' values can be negative. -- newtype Time = Time { getTime :: TimeBase }-  deriving (-    Eq,-    Ord,-    Typeable,-    Enum,--    Num,-    Fractional,-    Real,-    RealFrac-    )+  deriving (Eq, Ord, Typeable, Enum, Num, Fractional, Real, RealFrac)  -- Time forms an affine space with durations as the underlying vector space, that is, we -- can add a time to a duration to get a new time using '.+^', take the difference of two@@ -264,26 +249,6 @@   Time x .-. Time y     = Duration (x - y)   Time x .+^ Duration y = Time     (x + y) --- | Lay out a series of vectors from a given point. Return all intermediate points.--- --- > lenght xs + 1 == length (offsetPoints p xs)--- --- >>> offsetPoints 0 [1,1,1] :: [Time]--- [0,1,2,3]-offsetPoints :: AffineSpace p => p -> [Diff p] -> [p]-offsetPoints = scanl (.+^)---- | Calculate the relative difference between vectors.--- --- > lenght xs + 1 == length (offsetPoints p xs)--- --- >>> offsetPoints 0 [1,1,1] :: [Time]--- [0,1,2,3]-pointOffsets :: AffineSpace p => p -> [p] -> [Diff p]-pointOffsets or = (zeroV :) . snd . mapAccumL g or-  where-    g prev p = (p, p .-. prev)- -- | Interpret as durations from 0. -- -- > toAbsoluteTime (toRelativeTime xs) == xs@@ -296,11 +261,11 @@ toAbsoluteTime = tail . offsetPoints 0  -- | Duration between 0 and first value and so on until the last.--- +-- -- > toAbsoluteTime (toRelativeTime xs) == xs--- +-- -- > lenght xs == length (toRelativeTime xs)--- +-- -- >>> toRelativeTime [1,2,3] -- [1,1,1] toRelativeTime :: [Time] -> [Duration]@@ -331,12 +296,10 @@ -- Another way of looking at 'Span' is that it represents a time transformation where -- onset is translation and duration is scaling. --+-- This type is known as 'Arc' in Tidal and as 'Era' in the active package.+-- newtype Span = Span { getSpan :: (Time, Duration) }-  deriving (-    Eq,-    Ord,-    Typeable-    )+  deriving (Eq, Ord, Typeable)  -- You can create a span using the constructors '<->', '<-<' and '>->'. Note that: --@@ -531,8 +494,8 @@ -- Normalize a span, i.e. reverse it if negative, and do nothing otherwise. -- -- @--- _duration s = _duration (normalizeSpan s)--- _midpoint s = _midpoint (normalizeSpan s)+-- abs $ s^.'duration' = abs $ ('normalizeSpan' s)^.'duration'+-- s^.'midpoint' = ('normalizeSpan' s)^.'midpoint' -- @ -- normalizeSpan :: Span -> Span@@ -550,9 +513,6 @@ infixl 5 `encloses` infixl 5 `properlyEncloses` infixl 5 `overlaps`--- infixl 5 `encloses`--- infixl 5 `encloses`--- infixl 5 `encloses`  -- | -- Whether the given point falls inside the given span (inclusively).@@ -698,7 +658,7 @@ -- timespantools.timespan_2_stops_during_timespan_1 -- timespantools.timespan_2_stops_when_timespan_1_starts -- timespantools.timespan_2_stops_when_timespan_1_stops--- timespantools.timespan_2_trisects_timespan_1     +-- timespantools.timespan_2_trisects_timespan_1   

@@ -1,8 +1,8 @@ -{-# LANGUAGE ConstraintKinds            #-}+{-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses      #-}@@ -39,25 +39,19 @@         -- ** Separating rhythms and values         valuesV,         durationsV,-        -- withValues,-        -- withDurations,-        -- rotateValues,-        -- rotateDurations,-        -- reverseValues,-        -- reverseDurations,          -- ** Zips         unzipVoice,-        zipVoice,-        zipVoice3,-        zipVoice4,+        zipVoiceScale,+        zipVoiceScale3,+        zipVoiceScale4,         zipVoiceNoScale,         -- FIXME compose with (lens assoc unassoc) for the 3 and 4 versions         zipVoiceNoScale3,         zipVoiceNoScale4,-        zipVoiceWith,-        zipVoiceWith',+        zipVoiceScaleWith,         zipVoiceWithNoScale,+        zipVoiceWith',          -- * Fusion         fuse,@@ -66,7 +60,7 @@         -- ** Fuse rests         fuseRests,         coverRests,-        +         -- * Homophonic/Polyphonic texture         sameDurations,         mergeIfSameDuration,@@ -78,7 +72,7 @@         offsetsRelative,         midpointsRelative,         erasRelative,-        +         -- * Context         -- TODO clean         withContext,@@ -90,26 +84,6 @@    ) where -import           Data.AffineSpace-import           Data.AffineSpace.Point-import           Data.Functor.Adjunction  (unzipR)-import           Data.Functor.Context-import           Data.Map                 (Map)-import qualified Data.Map                 as Map-import           Data.Maybe-import           Data.Ratio-import           Data.Semigroup-import           Data.Set                 (Set)-import qualified Data.Set                 as Set-import           Data.Sequence            (Seq)-import qualified Data.Sequence            as Seq-import           Data.String-import           Data.VectorSpace--import           Music.Time.Reverse-import           Music.Time.Split-import           Music.Time.Note- import           Control.Applicative import           Control.Lens             hiding (Indexable, Level, above,                                            below, index, inside, parts,@@ -117,17 +91,33 @@ import           Control.Monad import           Control.Monad.Compose import           Control.Monad.Plus+import           Data.AffineSpace+import           Data.AffineSpace.Point import           Data.Foldable            (Foldable)-import qualified Data.Foldable            as Foldable-import qualified Data.List+import           Data.Functor.Adjunction  (unzipR)+import           Data.Functor.Context import           Data.List.NonEmpty       (NonEmpty)+import           Data.Maybe+import           Data.Semigroup+import           Data.Sequence            (Seq)+import           Data.Set                 (Set)+import           Data.String import           Data.Traversable         (Traversable)-import qualified Data.Traversable         as T-import           Data.Typeable+import           Data.Typeable            (Typeable)+import           Data.VectorSpace+import           Data.Aeson                    (ToJSON (..))+import qualified Data.Aeson                    as JSON+ import           Music.Dynamics.Literal import           Music.Pitch.Literal import           Music.Time.Internal.Util+import           Music.Time.Juxtapose+import           Music.Time.Note +import qualified Data.List+import qualified Data.Foldable+import qualified Data.Either+ -- | -- A 'Voice' is a sequential composition of non-overlapping note values. --@@ -140,17 +130,7 @@ -- (i.e. 'Duration'), that also happens to carry around other values, such as pitches. -- newtype Voice a = Voice { getVoice :: [Note a] }-  deriving (-    Eq,-    Ord,-    Typeable,-    Foldable, -    Traversable, --    Functor, -    Semigroup, -    Monoid -    )+  deriving (Eq, Ord, Typeable, Foldable, Traversable, Functor, Semigroup, Monoid)  instance (Show a, Transformable a) => Show (Voice a) where   show x = show (x^.notes) ++ "^.voice"@@ -182,7 +162,7 @@ instance MonadPlus Voice where   mzero = mempty   mplus = mappend-  + instance Wrapped (Voice a) where   type Unwrapped (Voice a) = [Note a]   _Wrapped' = iso getVoice Voice@@ -199,6 +179,12 @@     Nothing      -> Left  mempty     Just (xs, x) -> Right (view voice xs, x) +instance ToJSON a => ToJSON (Voice a) where+  -- TODO meta+  toJSON x = JSON.object [ ("notes", toJSON ns) ]+    where+      ns = x^.notes+       instance Transformable (Voice a) where   transform s = over notes (transform s) @@ -208,14 +194,40 @@ instance Reversible a => Reversible (Voice a) where   rev = over notes reverse . fmap rev --- instance Splittable a => Splittable (Voice a) where---   split t x---     | t <= 0           = (mempty, x)---     | t >= _duration x = (x,      mempty)---     | otherwise        = let (a,b) = split' t {-split-} (x^._Wrapped) in (a^._Unwrapped, b^._Unwrapped)---     where---       split' = error "TODO"+instance (Transformable a, Splittable a) => Splittable (Voice a) where+  -- TODO meta+  split d v = case splitNotes d (v^.notes) of+    (as,Nothing,cs)     -> (as^.voice, cs^.voice)+    (as,Just(b1,b2),cs) -> (as^.voice `snoc` b1, b2 `cons` cs^.voice) +splitNotes :: (Transformable a, Splittable a) => Duration -> [a] -> ([a], Maybe (a, a), [a])+splitNotes d xs = case (durAndNumNotesToFirst, needSplit) of+  (Just (_,0),_)     -> ([],Nothing,xs)+  (Nothing   ,False) -> (xs,Nothing,[])+  (Just (_,n),False) -> (take n xs,Nothing,drop n xs)+  (Nothing   ,True)  -> (init xs,Just (splitEnd (sum (fmap (^.duration) xs) - d) (last xs)),[])+  (Just (d',n),True) -> (+    take (n-1) xs+   ,Just (splitEnd (d'-d) (xs!!pred n)) -- (d'-d) is how much we have to cut+    ,drop n xs)+  where+    needSplit = case durAndNumNotesToFirst of+        Nothing     -> d < sum (fmap (^.duration) xs)+        Just (d',_) -> d /= d'+    -- Given dur is >= requested dur+    -- Nothing means all goes to first+    durAndNumNotesToFirst = accumUntil (\(ds,ns) x -> if ds < d then Left(ds+x,ns+1) else Right (ds,ns))+      (0,0) (fmap (^.duration) xs)+    splitEnd d x = split ((x^.duration) - d) x++    -- >>> accumUntil (\s a -> if s < 345 then Left (s + a) else Right s) 0 [1..]+    -- Just 351+    accumUntil :: (s -> a -> Either s b) -> s -> [a] -> Maybe b+    accumUntil f z xs = Data.Maybe.listToMaybe $ fmap fromRight $ dropWhile Data.Either.isLeft $ scanl (f . fromLeft) (Left z) xs+        where+          fromRight (Right x) = x+          fromLeft (Left x) = x+ instance IsString a => IsString (Voice a) where   fromString = pure . fromString @@ -231,26 +243,15 @@ -- Bogus instance, so we can use [c..g] expressions instance Enum a => Enum (Voice a) where   toEnum = return . toEnum-  fromEnum = list 0 (fromEnum . head) . Foldable.toList+  fromEnum = list 0 (fromEnum . head) . Data.Foldable.toList --- Bogus instance, so we can use numeric literals instance Num a => Num (Voice a) where   fromInteger = return . fromInteger   abs    = fmap abs   signum = fmap signum-  (+)    = (<>)-  (-)    = error "Not implemented"-  (*)    = error "Not implemented"--instance AdditiveGroup (Voice a) where-  zeroV   = mempty-  (^+^)   = (<>)-  negateV = error "Not implemented" -- TODO negate durations--instance VectorSpace (Voice a) where-  type Scalar (Voice a) = Duration-  d *^ s = d `stretch` s-+  (+)    = liftA2 (+)+  (-)    = liftA2 (-)+  (*)    = liftA2 (*)  -- | Create a 'Voice' from a list of 'Note's. voice :: Getter [Note a] (Voice a)@@ -290,7 +291,7 @@ -- 'toListOf' ('notes' . 'each')                :: 'Voice' a -> ['Note' a] -- 'toListOf' ('notes' . 'elements' odd)        :: 'Voice' a -> ['Note' a] -- 'toListOf' ('notes' . 'each' . 'filtered'---              (\\x -> '_duration' x \< 2))  :: 'Voice' a -> ['Note' a]+--              (\\x -> x^.'duration' \< 2))  :: 'Voice' a -> ['Note' a] -- @  -- | View a score as a list of duration-value pairs. Analogous to 'triples'.@@ -311,7 +312,7 @@ durationsVoice = iso (mconcat . fmap (\d -> stretch d $ pure ())) (^. durationsV)  -- |--- Unzip the given voice. This is specialization of 'unzipR'.+-- Unzip the given voice. -- unzipVoice :: Voice (a, b) -> (Voice a, Voice b) unzipVoice = unzipR@@ -319,26 +320,26 @@ -- | -- Join the given voices by multiplying durations and pairing values. ---zipVoice :: Voice a -> Voice b -> Voice (a, b)-zipVoice = zipVoiceWith (,)+zipVoiceScale :: Voice a -> Voice b -> Voice (a, b)+zipVoiceScale = zipVoiceScaleWith (,)  -- | -- Join the given voices by multiplying durations and pairing values. ---zipVoice3 :: Voice a -> Voice b -> Voice c -> Voice (a, (b, c))-zipVoice3 a b c = zipVoice a (zipVoice b c)+zipVoiceScale3 :: Voice a -> Voice b -> Voice c -> Voice (a, (b, c))+zipVoiceScale3 a b c = zipVoiceScale a (zipVoiceScale b c)  -- | -- Join the given voices by multiplying durations and pairing values. ---zipVoice4 :: Voice a -> Voice b -> Voice c -> Voice d -> Voice (a, (b, (c, d)))-zipVoice4 a b c d = zipVoice a (zipVoice b (zipVoice c d))+zipVoiceScale4 :: Voice a -> Voice b -> Voice c -> Voice d -> Voice (a, (b, (c, d)))+zipVoiceScale4 a b c d = zipVoiceScale a (zipVoiceScale b (zipVoiceScale c d))  -- | -- Join the given voices by multiplying durations and pairing values. ---zipVoice5 :: Voice a -> Voice b -> Voice c -> Voice d -> Voice e -> Voice (a, (b, (c, (d, e))))-zipVoice5 a b c d e = zipVoice a (zipVoice b (zipVoice c (zipVoice d e)))+zipVoiceScale5 :: Voice a -> Voice b -> Voice c -> Voice d -> Voice e -> Voice (a, (b, (c, (d, e))))+zipVoiceScale5 a b c d e = zipVoiceScale a (zipVoiceScale b (zipVoiceScale c (zipVoiceScale d e)))  -- | -- Join the given voices by pairing values and selecting the first duration.@@ -368,8 +369,8 @@ -- | -- Join the given voices by multiplying durations and combining values using the given function. ---zipVoiceWith :: (a -> b -> c) -> Voice a -> Voice b -> Voice c-zipVoiceWith = zipVoiceWith' (*)+zipVoiceScaleWith :: (a -> b -> c) -> Voice a -> Voice b -> Voice c+zipVoiceScaleWith = zipVoiceWith' (*)  -- | -- Join the given voices without combining durations.@@ -416,13 +417,13 @@     -- non-empty lists of equal elements.     foldNotes (unzip -> (ds, as)) = (sum ds, g as) --- | +-- | -- Fuse all rests in the given voice. The resulting voice will have no consecutive rests. -- fuseRests :: Voice (Maybe a) -> Voice (Maybe a) fuseRests = fuseBy (\x y -> isNothing x && isNothing y) --- | +-- | -- Remove all rests in the given voice by prolonging the previous note. Returns 'Nothing' -- if and only if the given voice contains rests only. --@@ -441,6 +442,9 @@ withContext :: Voice a -> Voice (Ctxt a) withContext = over valuesV addCtxt +-- durationsV and valuesV are useful, but slightly odd+-- What happens if the user changes the length of the list?+-- Is there a more safe idiom that can be used instead? -- TODO more elegant definition?  -- | A lens to the durations in a voice.@@ -491,25 +495,25 @@   | otherwise         = Nothing -- TODO could also use (zipVoiceWith' max) or (zipVoiceWith' min) --- |--- Split all notes of the latter voice at the onset/offset of the former.------ >>> ["a",(2,"b")^.note,"c"]^.voice--- [(1,"a")^.note,(2,"b")^.note,(1,"c")^.note]^.voice----splitLatterToAssureSameDuration :: Voice b -> Voice b -> Voice b-splitLatterToAssureSameDuration = splitLatterToAssureSameDurationWith dup-  where-    dup x = (x,x)--splitLatterToAssureSameDurationWith :: (b -> (b, b)) -> Voice b -> Voice b -> Voice b-splitLatterToAssureSameDurationWith = undefined--polyToHomophonic      :: [Voice a] -> Maybe (Voice [a])-polyToHomophonic = undefined+-- -- |+-- -- Split all notes of the latter voice at the onset/offset of the former.+-- --+-- -- >>> ["a",(2,"b")^.note,"c"]^.voice+-- -- [(1,"a")^.note,(2,"b")^.note,(1,"c")^.note]^.voice+-- --+-- splitLatterToAssureSameDuration :: Voice b -> Voice b -> Voice b+-- splitLatterToAssureSameDuration = splitLatterToAssureSameDurationWith dup+--   where+--     dup x = (x,x)+-- +-- splitLatterToAssureSameDurationWith :: (b -> (b, b)) -> Voice b -> Voice b -> Voice b+-- splitLatterToAssureSameDurationWith = undefined -polyToHomophonicForce :: [Voice a] -> Voice [a]-polyToHomophonicForce = undefined+-- polyToHomophonic      :: [Voice a] -> Maybe (Voice [a])+-- polyToHomophonic = undefined+-- +-- polyToHomophonicForce :: [Voice a] -> Voice [a]+-- polyToHomophonicForce = undefined  -- | Split a homophonic texture into a polyphonic one. The returned voice list will not -- have as many elements as the chord with the fewest number of notes.@@ -517,21 +521,24 @@ homoToPolyphonic xs = case nvoices xs of   Nothing -> []   Just n  -> fmap (\n -> fmap (!! n) xs) [0..n-1]-  where                  +  where     nvoices :: Voice [a] -> Maybe Int     nvoices = maybeMinimum . fmap length . (^.valuesV) -changeCrossing   :: Ord a => Voice a -> Voice a -> (Voice a, Voice a)-changeCrossing = undefined--changeCrossingBy :: Ord b => (a -> b) -> Voice a -> Voice a -> (Voice a, Voice a)-changeCrossingBy = undefined--processExactOverlaps :: (a -> a -> (a, a)) -> Voice a -> Voice a -> (Voice a, Voice a)-processExactOverlaps = undefined+    maybeMinimum :: Ord a => [a] -> Maybe a+    maybeMinimum xs = if null xs then Nothing else Just (minimum xs) -processExactOverlaps' :: (a -> b -> Either (a,b) (b,a)) -> Voice a -> Voice b -> (Voice (Either b a), Voice (Either a b))-processExactOverlaps' = undefined+-- changeCrossing   :: Ord a => Voice a -> Voice a -> (Voice a, Voice a)+-- changeCrossing = undefined+-- +-- changeCrossingBy :: Ord b => (a -> b) -> Voice a -> Voice a -> (Voice a, Voice a)+-- changeCrossingBy = undefined+-- +-- processExactOverlaps :: (a -> a -> (a, a)) -> Voice a -> Voice a -> (Voice a, Voice a)+-- processExactOverlaps = undefined+-- +-- processExactOverlaps' :: (a -> b -> Either (a,b) (b,a)) -> Voice a -> Voice b -> (Voice (Either b a), Voice (Either a b))+-- processExactOverlaps' = undefined  -- | Returns the onsets of all notes in a voice given the onset of the first note. onsetsRelative    :: Time -> Voice a -> [Time]@@ -553,94 +560,19 @@ erasRelative :: Time -> Voice a -> [Span] erasRelative o v = zipWith (<->) (onsetsRelative o v) (offsetsRelative o v) -onsetMap  :: Time -> Voice a -> Map Time a-onsetMap = undefined+{-+onsetMap  :: Score a -> Map Time a+onsetMap = fmap (view onset) . eraMap -offsetMap :: Time -> Voice a -> Map Time a-offsetMap = undefined+offsetMap :: Score a -> Map Time a+offsetMap = fmap (view offset) . eraMap -midpointMap :: Time -> Voice a -> Map Time a-midpointMap = undefined+midpointMap :: Score a -> Map Time a+midpointMap = fmap (view midpoint) . eraMap -eraMap :: Time -> Voice a -> Map Span a-eraMap = undefined+eraMap :: Score a -> Map Span a+eraMap = error "No eraMap"  durations :: Voice a -> [Duration]-durations = undefined---- values :: Voice a -> [a] -- Same as Foldable.toList--- values = undefined----{---sameDurations           :: Voice a -> Voice b -> Bool-mergeIfSameDuration     :: Voice a -> Voice b -> Maybe (Voice (a, b))-mergeIfSameDurationWith :: (a -> b -> c) -> Voice a -> Voice b -> Maybe (Voice c)-splitAt :: [Duration] -> Voice a -> [Voice a]--- splitTiesAt :: Tiable a => [Duration] -> Voice a -> [Voice a]-splitLatterToAssureSameDuration :: Voice b -> Voice b -> Voice b-splitLatterToAssureSameDurationWith :: (b -> (b, b)) -> Voice b -> Voice b -> Voice b-polyToHomophonic      :: [Voice a] -> Maybe (Voice [a])-polyToHomophonicForce :: [Voice a] -> Voice [a]-homoToPolyphonic      :: Voice [a] -> [Voice a]-joinVoice             :: Voice (Voice a) -> a-changeCrossing   :: Ord a => Voice a -> Voice a -> (Voice a, Voice a)-changeCrossingBy :: Ord b => (a -> b) -> Voice a -> Voice a -> (Voice a, Voice a)-processExactOverlaps :: (a -> a -> (a, a)) -> Voice a -> Voice a -> (Voice a, Voice a)-processExactOverlaps' :: (a -> b -> Either (a,b) (b,a)) -> Voice a -> Voice b -> (Voice (Either b a), Voice (Either a b))-onsetsRelative    :: Time -> Voice a -> [Time]-offsetsRelative   :: Time -> Voice a -> [Time]-midpointsRelative :: Time -> Voice a -> [Time]-erasRelative      :: Time -> Voice a -> [Span]-onsetMap  :: Time -> Voice a -> Map Time a-offsetMap :: Time -> Voice a -> Map Time a-midpointMap :: Time -> Voice a -> Map Time a-eraMap :: Time -> Voice a -> Map Span a-durations :: Voice a -> [Duration]-values    :: Voice a -> [a] -- Same as Foldable.toList-isPossiblyInfinite :: Voice a -> Bool-hasMelodicDissonanceWith :: (a -> a -> Bool) -> Voice a -> Bool-hasIntervalWith :: AffineSpace a => (Diff a -> Bool) -> Voice a -> Bool-hasDurationWith :: (Duration -> Bool) -> Voice a -> Bool-reifyVoice :: Voice a -> Voice (Duration, a)-mapWithIndex :: (Int -> a -> b) -> Voice a -> Voice b-mapWithDuration :: (Duration -> a -> b) -> Voice a -> Voice b-mapWithIndexAndDuration :: (Int -> Duration -> a -> b) -> Voice a -> Voice b-_ :: Iso (Voice ()) [Duration]-asingleton' :: Prism (Voice a) (Duration, a)-asingleton :: Prism (Voice a) a-separateVoicesWith :: (a -> k) -> Voice a -> Map k (Voice a)-freeVoiceR :: (forall a. -> [a] -> a)          -> Voice a -> (a, Duration)-freeVoiceRNoDur :: ([a] -> a)          -> Voice a -> a-freeVoice  :: (forall a. -> [a] -> [a])        -> Voice a -> Voice a-freeVoice2 :: (forall a. -> [a] -> [a] -> [a]) -> Voice a -> Voice a -> Voice a-empty :: Voice a-singleton :: a -> Voice a-cons :: a -> Voice a -> Voice a-snoc :: Voice a -> a -> Voice a-append :: Voice a -> Voice a -> Voice a-ap :: Voice (a -> b) -> Voice a -> Voice b-apDur :: Voice (Duration -> Duration -> a -> b) -> Voice a -> Voice b-intersperse :: Duration -> a -> Voice a -> Voice a--- intercalate :: Voice a -> Voice (Voice a) -> Voice a-subsequences :: Voice a -> [Voice a]-permutations :: Voice a -> [Voice a]-iterate :: (a -> a) -> a -> Voice a-repeat :: a -> Voice a-replicate :: Int -> a -> Voice a-unfoldr :: (b -> Maybe (a, b)) -> b -> Voice a-Differences between Voice and Chord (except the obviously different composition styles):-  - Voice is a Monoid, Chord just a Semigroup (??)-  - TODO represent spanners using (Voice a, Map (Int,Int) s)-  Arguably this should be part of Voice-  TODO the MVoice/TVoice stuff-newtype MVoice = Voice (Maybe a)-newtype PVoice = [Either Duration (Voice a)]-expandRepeats :: [Voice (Variant a)] -> Voice a-+durations = view durationsV -}--maybeMinimum xs = if null xs then Nothing else Just (minimum xs)-maybeMaximum xs = if null xs then Nothing else Just (maximum xs)