music-preludes 1.6.2 → 1.7

raw patch · 12 files changed

+158/−178 lines, 12 filesdep +asyncdep ~lensdep ~lilyponddep ~music-dynamics

Dependencies added: async

Dependency ranges changed: lens, lilypond, music-dynamics, music-dynamics-literal, music-parts, music-pitch, music-pitch-literal, music-score, musicxml2

Files

• music-preludes.cabal +16/−13
• src/Music/Prelude.hs +23/−0
• src/Music/Prelude/Basic.hs +12/−11
• src/Music/Prelude/CmdLine.hs +18/−11
• src/Music/Prelude/Instances.hs +68/−21
• src/Music/Prelude/Piano.hs +0/−47
• src/Music/Prelude/Standard.hs +12/−10
• src/Music/Prelude/StringQuartet.hs +0/−52
• tests/tests.hs +3/−1
• tools/music2ly.hs +2/−4
• tools/music2midi.hs +2/−4
• tools/music2musicxml.hs +2/−4

@@ -1,6 +1,6 @@  name:                   music-preludes-version:                1.6.2+version:                1.7 author:                 Hans Hoglund maintainer:             Hans Hoglund license:                BSD3@@ -22,7 +22,7 @@  library     build-depends:      base                    >= 4 && < 5,-                        lens,+                        lens				            >= 4.1.2 && < 4.2,                         split,                         unix,                         containers,@@ -36,18 +36,21 @@                         data-default,                         monadplus,                         reverse-apply,-                        lilypond                == 1.6.2,-                        musicxml2               == 1.6.2,-                        music-score             == 1.6.2,-                        music-pitch             == 1.6.2,-                        music-dynamics          == 1.6.2,-                        music-parts             == 1.6.2,-                        music-pitch-literal     == 1.6.2,-                        music-dynamics-literal  == 1.6.2-    exposed-modules:    Music.Prelude.Basic+                        lilypond                == 1.7,+                        musicxml2               == 1.7,+                        music-score             == 1.7,+                        music-pitch             == 1.7,+                        music-dynamics          == 1.7,+                        music-parts             == 1.7,+                        music-pitch-literal     == 1.7,+                        music-dynamics-literal  == 1.7,+                        -- For examples:+                        async+    exposed-modules:    Music.Prelude+                        Music.Prelude.Basic                         Music.Prelude.Standard-                        Music.Prelude.Piano-                        Music.Prelude.StringQuartet+                        -- Music.Prelude.Piano+                        -- Music.Prelude.StringQuartet                         Music.Prelude.CmdLine                         Music.Prelude.Instances     hs-source-dirs:     src

@@ -0,0 +1,23 @@++------------------------------------------------------------------------------------+-- |+-- Copyright   : (c) Hans Hoglund 2012-2014+--+-- License     : BSD-style+--+-- Maintainer  : hans@hanshoglund.se+-- Stability   : experimental+-- Portability : non-portable+--+-- The Music Suite comes with many standard preludes.+--+-- This module reexports "Music.Prelude.Standard" for convenience.+--+-------------------------------------------------------------------------------------++module Music.Prelude (+        module Music.Prelude.Standard+  ) where++import Music.Prelude.Standard+

@@ -40,15 +40,16 @@  import           Music.Dynamics import           Music.Parts             hiding (Part)-import           Music.Pitch             hiding (Fifths, Interval, Note, Part,+import           Music.Pitch             hiding (Fifths, Note, Part,                                           pitch) -- Need to export Pitch.Pitch for transf for now  import qualified Music.Pitch-import           Music.Score             hiding (Pitch)+import           Music.Score             hiding (Pitch, Interval)  import           Control.Lens.Operators  hiding ((<.>), (<|), (|>)) import           Control.Monad.Plus+import Data.Semigroup (Product)  import           Music.Prelude.Instances () @@ -65,19 +66,19 @@ asTrack = id  type BasicNote = (PartT BasicPart-    (TremoloT-      (TextT-        (ArticulationT+  (TextT+    (TieT+      (SlideT+        (TremoloT           (HarmonicT-            (TieT-              (SlideT-                (DynamicT-                  (ChordT-                      BasicPitch)))))))))+            (ArticulationT (Sum Double, Sum Double)+              (DynamicT (Sum Double)+                [Behavior BasicPitch]))))))))  type BasicPitch = Music.Pitch.Pitch  open          = openLilypond . asScore-play          = playMidiIO mempty . asScore+play          = error "Not implemented: play" openAndPlay x = open x >> play x+ 

@@ -6,6 +6,7 @@         versionString ) where +import           Control.Exception import           Data.Version          (showVersion) import           Data.Monoid import           Options.Applicative@@ -28,7 +29,7 @@  -- TODO Can not link due to haskell/cabal#1759 versionString :: String-versionString = "1.6"+versionString = "1.7" -- versionString = showVersion version  data Options = Options {@@ -47,8 +48,11 @@ runConverter func ext (Options prelude outFile inFile) =   translateFile func ext prelude (Just inFile) outFile -converterMain :: String -> String -> String -> IO ()-converterMain func ext pgmName = execParser opts >>= runConverter func ext+converterMain :: String -> String -> IO ()+converterMain func ext = getProgName >>= converterMain' func ext++converterMain' :: String -> String -> String -> IO ()+converterMain' func ext pgmName = execParser opts >>= runConverter func ext   where        opts = info          (helper <*> converterOptions) @@ -90,11 +94,12 @@    withSystemTempDirectory "music-suite." $ \tmpDir -> do     let tmpFile = tmpDir ++ "/" ++ takeFileName inFile+    let opts = ["-XOverloadedStrings", "-XNoMonomorphismRestriction", "-XTypeFamilies"]     putStrLn $ "Converting music..."     writeFile tmpFile newScore     withMusicSuiteInScope $ do       putStrLn $ "Writing '" ++ outFile ++ "'..."-      rawSystem "runhaskell" [tmpFile]+      rawSystem "runhaskell" (opts <> [tmpFile])  >>= \e -> if e == ExitSuccess then return () else fail ("Could not convert"++inFile)    return ()   where@@ -131,16 +136,18 @@ --    ... -- @ ---withEnv :: String -> (Maybe String -> String) -> IO a -> IO ()+withEnv :: String -> (Maybe String -> String) -> IO a -> IO a withEnv n f k = do   x <- PE.getEnv n   PE.setEnv n (f x) True-  k+  res <- k   case x of-    Nothing -> PE.unsetEnv n-    Just x2 -> PE.setEnv n x2 True+    Nothing -> PE.unsetEnv n >> return res+    Just x2 -> PE.setEnv n x2 True >> return res --- TODO if no music-util, use ""+withMusicSuiteInScope :: IO a -> IO a withMusicSuiteInScope k = do-  packagePath <- readProcess "music-util" ["package-path"] ""-  withEnv "GHC_PACKAGE_PATH" (const packagePath) k+  r <- try $ readProcess "music-util" ["package-path"] ""+  case r of+    Left x            -> let _ = (x::SomeException) in withEnv "GHC_PACKAGE_PATH" (const "") k+    Right packagePath -> withEnv "GHC_PACKAGE_PATH" (const packagePath) k

@@ -39,39 +39,73 @@  deriving instance Typeable Music.Parts.Part +instance Transformable Music.Parts.Part where+  transform _ = id+type instance Music.Score.Part Music.Parts.Part = Music.Parts.Part+type instance SetPart a Music.Parts.Part = a++instance (Transformable a, a ~ Music.Score.Part a) => HasPart Music.Parts.Part a where+  part = ($)+instance (Transformable a, a ~ Music.Score.Part a) => HasParts Music.Parts.Part a where+  parts = ($)++++instance Transformable BasicPart where+  transform _ = id type instance Music.Score.Part BasicPart = BasicPart-instance HasPart BasicPart where-    getPart = id-    modifyPart = id+type instance SetPart a BasicPart = a --- FIXME-instance Delayable Pitch-instance Stretchable Pitch+instance (Transformable a, a ~ Music.Score.Part a) => HasPart BasicPart a where+  part = ($)+instance (Transformable a, a ~ Music.Score.Part a) => HasParts BasicPart a where+  parts = ($)++instance Transformable Pitch where+  transform _ = id type instance Score.Pitch Pitch = Pitch+type instance SetPitch a Pitch = a -instance HasGetPitch Pitch where-    __getPitch = id-instance (a ~ Score.Pitch a) => HasSetPitch Pitch a where-    type SetPitch a Pitch = a-    __mapPitch = id+instance (Transformable a, a ~ Score.Pitch a) => HasPitch Pitch a where+  pitch = ($)+instance (Transformable a, a ~ Score.Pitch a) => HasPitches Pitch a where+  pitches = ($)+ instance Tiable Pitch where     beginTie = id     endTie = id -instance HasMidi Semitones where-    getMidi a = getMidi $ (fromIntegral a :: Integer)+instance HasBackendNote Midi Semitones where+  exportNote b = exportNote b . fmap toInteger+  exportChord b = exportChord b . fmap (fmap toInteger) -instance HasMidi Pitch where-    getMidi p = getMidi $ semitones (p .-. c)+instance HasBackendNote Midi Pitch where+  exportNote b = exportNote b . fmap (\p -> semitones (p .-. c))+  exportChord b = exportChord b . fmap (fmap (\p -> semitones (p .-. c))) -instance HasMusicXml Pitch where-    getMusicXml      (realToFrac -> d) = (`Xml.note` d) . snd3 Just . spellPitch 4-    getMusicXmlChord (realToFrac -> d) = (`Xml.chord` (realToFrac d)) . fmap (snd3 Just . spellPitch 4)+instance HasBackendNote SuperCollider Semitones where+  exportNote b = exportNote b . fmap toInteger+  exportChord b = exportChord b . fmap (fmap toInteger) -instance HasLilypond Pitch where-    getLilypond      d = (^*realToFrac (d*4)) . Lilypond.note . pitchLilypond . Lilypond.Pitch . spellPitch 5-    getLilypondChord d = (^*realToFrac (d*4)) . Lilypond.chord . fmap (pitchLilypond . Lilypond.Pitch . spellPitch 5)+instance HasBackendNote SuperCollider Pitch where+  exportNote b = exportNote b . fmap (\p -> semitones (p .-. c))+  exportChord b = exportChord b . fmap (fmap (\p -> semitones (p .-. c))) ++instance HasBackendNote MusicXml Pitch where+  exportNote  _ (XmlContext d Nothing)    = Xml.rest (realToFrac d)+  exportNote  _ (XmlContext d (Just x))   = (`Xml.note` realToFrac d) . snd3 Just . spellPitch 4 $ x++  exportChord _ (XmlContext d Nothing)    = Xml.rest (realToFrac d)+  exportChord _ (XmlContext d (Just xs))  = (`Xml.chord` (realToFrac d)) . fmap (snd3 Just . spellPitch 4) $ xs++instance HasBackendNote Lilypond Pitch where+  exportNote  _ (LyContext d Nothing)    = (^*realToFrac (4*d)) Lilypond.rest+  exportNote  _ (LyContext d (Just x))   = (^*realToFrac (d*4)) . Lilypond.note . pitchLilypond . Lilypond.Pitch . spellPitch 5 $ x++  exportChord _ (LyContext d Nothing)    = (^*realToFrac (4*d)) Lilypond.rest+  exportChord _ (LyContext d (Just xs))  = (^*realToFrac (d*4)) . Lilypond.chord . fmap (pitchLilypond . Lilypond.Pitch . spellPitch 5) $ xs+ -- TODO move snd3 f (a, b, c) = (a, f b, c) pitchLilypond a = Lilypond.NotePitch a Nothing@@ -96,3 +130,16 @@                 41 -> 48                 42 -> 48                 x  -> x++instance HasLilypondInstrument BasicPart where+    getLilypondClef = 0++instance HasLilypondInstrument Music.Parts.Part where+    getLilypondClef = defaultClef++instance HasMusicXmlInstrument BasicPart where+    getMusicXmlClef = 0++instance HasMusicXmlInstrument Music.Parts.Part where+    getMusicXmlClef = defaultClef+

@@ -1,47 +0,0 @@--{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}----------------------------------------------------------------------------------------- |--- Copyright   : (c) Hans Hoglund 2012------ License     : BSD-style------ Maintainer  : hans@hanshoglund.se--- Stability   : experimental--- Portability : non-portable (TF,GNTD)------ A basic music representation for piano.-------------------------------------------------------------------------------------------module Music.Prelude.Piano (-        module Music.Score,-        PianoPart,-        Note,-        asScore-  ) where--import           Data.AffineSpace.Point-import           Data.Typeable-import           Music.Dynamics.Literal-import qualified Music.Lilypond         as Lilypond-import qualified Music.MusicXml.Simple  as Xml-import           Music.Pitch-import           Music.Score            hiding (Interval, Note, Pitch)-import qualified Music.Score            as Score--asScore :: Score Note -> Score Note-asScore = id--data PianoPart-    = Pno-    deriving (Eq, Ord, Enum)--instance Show PianoPart where-    show Pno  = "Piano"--type Note = (PartT PianoPart (TieT-    (TremoloT (HarmonicT (SlideT-        (DynamicT (ArticulationT (TextT Integer))))))))

@@ -62,22 +62,24 @@ -- instance Show BasicPart where --     show _ = "" -type Note = (PartT Part-    (TremoloT-      (TextT-        (ArticulationT-          (HarmonicT-            (TieT+type Note = +  (PartT Part+    (TieT+      (ColorT +        (TextT+          (TremoloT+            (HarmonicT               (SlideT-                (DynamicT-                  (ChordT-                    StandardPitch)))))))))+                (ArticulationT (Sum Double, Sum Double)+                  (DynamicT (Sum Double)+                    [Behavior StandardPitch])))))))))+ type StandardPitch = Music.Pitch.Pitch -- data StandardPitch = StandardPitch Music.Pitch.Pitch     -- deriving (HasMidi, HasLilypond, HasMusicXml, HasPitch)   open          = openLilypond . asScore-play          = playMidiIO mempty . asScore+play          = error "Not implemented: play" openAndPlay x = open x >> play x 

@@ -1,52 +0,0 @@--{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}----------------------------------------------------------------------------------------- |--- Copyright   : (c) Hans Hoglund 2012------ License     : BSD-style------ Maintainer  : hans@hanshoglund.se--- Stability   : experimental--- Portability : non-portable (TF,GNTD)------ A basic music representation for string quartet.------------------------------------------------------------------------------------------module Music.Prelude.StringQuartet (-        module Music.Score,-        StringQuartetPart,-        Note,-        asScore-  ) where--import           Data.AffineSpace.Point-import           Data.Typeable-import           Music.Dynamics.Literal-import qualified Music.Lilypond         as Lilypond-import qualified Music.MusicXml.Simple  as Xml-import           Music.Pitch-import           Music.Score            hiding (Interval, Note, Pitch)-import qualified Music.Score            as Score--asScore :: Score Note -> Score Note-asScore = id--data StringQuartetPart-    = Vl1-    | Vl2-    | Vla-    | Vc-    deriving (Eq, Ord, Enum, Typeable)--instance Show StringQuartetPart where-    show Vl1  = "Violin I"-    show Vl2  = "Violin II"-    show Vla  = "Viola"-    show Vc   = "Cello"--type Note = (PartT StringQuartetPart (TieT-    (TremoloT (HarmonicT (SlideT-        (DynamicT (ArticulationT (TextT Integer))))))))

@@ -1,6 +1,7 @@  module Main where +import System.Exit import Test.Tasty import Test.Tasty.Golden import System.Process@@ -24,7 +25,7 @@     ("tests/golden/" ++ name ++ "." ++ ext)     ("tests/current/" ++ name ++ "." ++ ext)     ((system $ converter ext ++" -o tests/current/"++name++"."++ext++" tests/"++name++".music") -      >> return ())+      >>= \e -> if e == ExitSuccess then return () else fail ("Could not convert "++name++".music"))  {-   This test will always fail if the test files have been edited.@@ -65,6 +66,7 @@   testMusicFile "dynamics_constant",   testMusicFile "melody_chords",   testMusicFile "meta_annotations",+  testMusicFile "meta_title",   testMusicFile "meta_clef1",   testMusicFile "meta_composer",   testMusicFile "meta_time_signature",

@@ -1,8 +1,6 @@  module Main where -import           Music.Prelude.CmdLine-import           System.Environment+import Music.Prelude.CmdLine -main :: IO ()-main = getProgName >>= converterMain "writeLilypond" "ly"+main = converterMain "writeLilypond" "ly"

@@ -1,8 +1,6 @@  module Main where -import           Music.Prelude.CmdLine-import           System.Environment+import Music.Prelude.CmdLine -main :: IO ()-main = getProgName >>= converterMain "writeMidi" "mid"+main = converterMain "writeMidi" "mid"

@@ -1,8 +1,6 @@  module Main where -import           Music.Prelude.CmdLine-import           System.Environment+import Music.Prelude.CmdLine -main :: IO ()-main = getProgName >>= converterMain "writeMusicXml" "xml"+main = converterMain "writeMusicXml" "xml"