lilypond 1.6.2 → 1.7
raw patch · 4 files changed
+71/−24 lines, 4 filesdep ~music-dynamics-literaldep ~music-pitch-literal
Dependency ranges changed: music-dynamics-literal, music-pitch-literal
Files
- lilypond.cabal +3/−3
- src/Music/Lilypond.hs +57/−19
- src/Music/Lilypond/Dynamics.hs +2/−1
- src/Music/Lilypond/Value.hs +9/−1
lilypond.cabal view
@@ -1,6 +1,6 @@ name: lilypond-version: 1.6.2+version: 1.7 author: Hans Hoglund maintainer: Hans Hoglund <hans@hanshoglund.se> license: BSD3@@ -28,8 +28,8 @@ process, data-default, prettify,- music-pitch-literal == 1.6.2,- music-dynamics-literal == 1.6.2+ music-pitch-literal == 1.7,+ music-dynamics-literal == 1.7 exposed-modules: Music.Lilypond Music.Lilypond.Pitch Music.Lilypond.Dynamics
src/Music/Lilypond.hs view
@@ -31,6 +31,7 @@ -- ** Attributes Value, toValue,+ toLiteralValue, -- ** Articulation and dynamics PostEvent(..),@@ -200,8 +201,52 @@ | New String (Maybe String) Music -- ^ New expression. | Context String (Maybe String) Music -- ^ Context expression. | Set String Value + | Override String Value+ | Revert String deriving (Eq, Show) +foldMusic :: (Music -> Music) -> Music -> Music+foldMusic f = go+ where+ go (Sequential ms) = Sequential (fmap go ms) + go (Simultaneous b ms) = Simultaneous b (fmap go ms) + go (Repeat b i m qmm) = Repeat b i m (fmap (go *** go) qmm) + go (Tremolo n m) = Tremolo n (go m) + go (Times r m) = Times r (go m) + go (Transpose p p2 m) = Transpose p p2 (go m) + go (Relative p m) = Relative p (go m) + go (New s v m) = New s v (go m) + go (Context s v m) = Context s v (go m)+ go x = f x++foldMusic' :: (Music -> Music) -- Rest Note Chord+ -> (Music -> Music) -- Other non-recursive+ -> (Music -> Music) -- Recursive+ -> Music -> Music+foldMusic' f g h = go+ where + go m@(Rest _ _) = f m+ go m@(Note _ _ _) = f m+ go m@(Chord _ _ _) = f m+ go m@(Clef _) = g m+ go m@(Key _ _) = g m+ go m@(Time _ _) = g m+ go m@(Breathe _) = g m+ go m@(Tempo _ _) = g m+ go m@(Set _ _) = g m+ go m@(Override _ _) = g m+ go m@(Revert _) = g m+ go (Sequential ms) = Sequential (fmap h ms) + go (Simultaneous b ms) = Simultaneous b (fmap h ms) + go (Repeat b i m qmm) = Repeat b i m (fmap (h *** h) qmm) + go (Tremolo n m) = Tremolo n (h m) + go (Times r m) = Times r (h m) + go (Transpose p p2 m) = Transpose p p2 (h m) + go (Relative p m) = Relative p (h m) + go (New s v m) = New s v (h m) + go (Context s v m) = Context s v (h m)++ instance Pretty Music where pretty (Rest d p) = "r" <> pretty d <> prettyList p @@ -260,8 +305,14 @@ "\\context" <+> string typ <+> pretty name <+> pretty x pretty (Set name val) =- "\\set" <+> string name <+> "=" <+> (string . show) val+ "\\set" <+> string name <+> "=" <+> pretty val + pretty (Override name val) =+ "\\override" <+> string name <+> "=" <+> pretty val++ pretty (Revert name) =+ "\\revert" <+> string name+ -- pretty _ = notImpl "Unknown music expression" prettyList = hsep . fmap pretty@@ -605,10 +656,11 @@ addPost :: PostEvent -> Music -> Music-addPost a (Rest d es) = Rest d (es ++ [a])-addPost a (Note n d es) = Note n d (es ++ [a])-addPost a (Chord ns d es) = Chord ns d (es ++ [a])-addPost a m = m+addPost a = foldMusic' (addPost' a) id (addPost a)+ where+ addPost' a (Rest d es) = Rest d (es ++ [a])+ addPost' a (Note n d es) = Note n d (es ++ [a])+ addPost' a (Chord ns d es) = Chord ns d (es ++ [a]) addText :: String -> Music -> Music addText s = addPost (Text def s)@@ -789,20 +841,6 @@ addVarCoda = addArticulation VarCoda --foldMusic :: (Music -> Music) -> Music -> Music-foldMusic f = go- where- go (Sequential ms) = Sequential (fmap go ms) - go (Simultaneous b ms) = Simultaneous b (fmap go ms) - go (Repeat b i m qmm) = Repeat b i m (fmap (go *** go) qmm) - go (Tremolo n m) = Tremolo n (go m) - go (Times r m) = Times r (go m) - go (Transpose p p2 m) = Transpose p p2 (go m) - go (Relative p m) = Relative p (go m) - go (New s v m) = New s v (go m) - go (Context s v m) = Context s v (go m)- go x = f x removeSingleChords :: Music -> Music removeSingleChords = foldMusic go
src/Music/Lilypond/Dynamics.hs view
@@ -57,6 +57,7 @@ 2.5 -> FF 3.5 -> FFF 4.5 -> FFFF- fromDynamics _ = error "fromDynamics: Unsupported literal for MusicXml.Dynamics"+ x -> error $ "Lilypond.Dynamics: Strange value " ++ show x+ fromDynamics _ = error "Lilypond.Dynamics: Unsupported literal"
src/Music/Lilypond/Value.hs view
@@ -19,6 +19,7 @@ module Music.Lilypond.Value ( Value, toValue,+ toLiteralValue, ) where import Data.String@@ -39,7 +40,7 @@ -- > \set Staff.instrumentName = "Violin I" -- > \set Staff.instrumentName = 2 ---data Value = forall a . Show a => Value a+data Value = forall a . Show a => Value a | Literal String instance IsString Value where fromString = toValue@@ -64,9 +65,16 @@ instance Eq Value where a == b = show a == show b +instance Pretty Value where+ pretty (Value x) = (string . show) x+ pretty (Literal x) = string x+ toValue :: Show a => a -> Value toValue = Value +-- | As 'toValue', but not quoting strings. Handy for scheme literals such as @#red@.+toLiteralValue :: String -> Value+toLiteralValue = Literal noOverloading :: String -> a