module Music.Time.Note (
Note,
note,
event,
noteValue,
) 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.String
import Data.VectorSpace
import Control.Applicative
import Control.Comonad
import Control.Comonad.Env
import Control.Lens hiding (Indexable, Level, above, below,
index, inside, parts, reversed,
transform, (<|), (|>))
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Data.PairMonad
import Data.Typeable
import Music.Pitch.Literal
import Music.Dynamics.Literal
import Music.Time.Internal.Util (through, tripped)
import Music.Time.Reverse
import Music.Time.Split
newtype Note a = Note { _noteValue :: (Span, a) }
deriving (Typeable)
deriving instance Eq a => Eq (Note a)
deriving instance Functor Note
deriving instance Foldable Note
deriving instance Traversable Note
deriving instance Comonad Note
instance (Show a, Transformable a) => Show (Note a) where
show x = show (x^.from note) ++ "^.note"
deriving instance Monad Note
deriving instance Applicative Note
instance Wrapped (Note a) where
type Unwrapped (Note a) = (Span, a)
_Wrapped' = iso _noteValue Note
instance Rewrapped (Note a) (Note b)
instance Transformable (Note a) where
transform t = over (_Wrapped . _1) $ transform t
instance HasDuration (Note a) where
_duration = _duration . ask . view _Wrapped
instance HasPosition (Note a) where
x `_position` p = ask (view _Wrapped x) `_position` p
instance Splittable a => Splittable (Note a) where
beginning d = over _Wrapped $ \(s, v) -> (beginning d s, beginning (d / _duration s) v)
ending d = over _Wrapped $ \(s, v) -> (ending d s, ending (d / _duration s) v)
instance Reversible (Note a) where
rev = revDefault
instance IsString a => IsString (Note a) where
fromString = pure . fromString
instance IsPitch a => IsPitch (Note a) where
fromPitch = pure . fromPitch
instance IsInterval a => IsInterval (Note a) where
fromInterval = pure . fromInterval
instance IsDynamics a => IsDynamics (Note a) where
fromDynamics = pure . fromDynamics
note :: () => Iso (Span, a) (Span, b) (Note a) (Note b)
note = _Unwrapped
noteValue :: (Transformable a, Transformable b) => Lens (Note a) (Note b) a b
noteValue = lens runNote (flip $ mapNote . const)
where
runNote = uncurry transform . view _Wrapped
mapNote f (view (from note) -> (s,x)) = view note (s, f `whilst` negateV s $ x)
event :: Iso (Note a) (Note b) (Time, Duration, a) (Time, Duration, b)
event = from note . bimapping delta id . tripped