Merge pull request #6 from slpopejoy/musicxml-3.0

Upgrade to MusicXML 3.1

CHANGELOG.md

@@ -1,3 +1,6 @@
+2.0:
+  - Upgrade to MusicXML 3.1. "build-old" flag will build older modules, see cabal file.
+
 1.1.1:
   - Support base 4.10
 

fadno-xml.cabal

@@ -1,9 +1,10 @@
 name:                fadno-xml
-version:             1.1.3
+version:             1.2
 synopsis:            XML/XSD combinators/schemas/codegen
 description:
             Library for generating code from XML schema files, with
-            MusicXml 2.0 schema library included. Includes
+            MusicXml 3.1 schema library included. (2.0 and 3.0 can be
+            also built with the 'build-old' cabal flag). Includes
             XML "combinator library" XParser for consuming xml,
             a type model for XSD productions, a type model for
             codegen, and the code generator.
@@ -19,14 +20,23 @@ build-type:          Simple
 -- extra-source-files:
 cabal-version:       >=1.10
 
+flag build-old
+  description: Expose/build old MusicXML (2.0,3.0) modules with 3.1.
+  default:     False
+  manual:      True
+
 library
   exposed-modules: Fadno.Xml.Codegen
                    Fadno.Xml.EmitTypes
                    Fadno.Xml.ParseXsd
                    Fadno.Xml.XParser
                    Fadno.Xml.XParse
                    Fadno.Xml.EmitXml
+                   Fadno.MusicXml.MusicXml31
+  if flag(build-old)
+    exposed-modules:
                    Fadno.MusicXml.MusicXml20
+                   Fadno.MusicXml.MusicXml30
   -- other-modules:
   -- other-extensions:
   build-depends:       Decimal >= 0.4

src/Fadno/Gen/GenMusicXml.hs

@@ -14,17 +14,29 @@ import System.IO
 -- | Emit the first element only.
 emitOneElement :: IO (Type,EmitState)
 emitOneElement = do
-  s <- loadMusicXml20
+  s <- loadMusicXml "xsd/musicxml.20.xsd"
   runEmit (Env s) mempty $ emitElement (head $ M.elems $ _elements s)
 
 -- | Emit 2.0 code.
 runMusicXml20 :: IO ()
-runMusicXml20 = do
-  s <- loadMusicXml20
+runMusicXml20 = runMusicXml "xsd/musicxml.20.xsd" "src/Fadno/MusicXml/MusicXml20.hs" "Fadno.MusicXml.MusicXml20"
+
+-- | Emit 3.0 code.
+runMusicXml30 :: IO ()
+runMusicXml30 = runMusicXml "xsd/musicxml.30.xsd" "src/Fadno/MusicXml/MusicXml30.hs" "Fadno.MusicXml.MusicXml30"
+
+-- | Emit 3.1 code.
+runMusicXml31 :: IO ()
+runMusicXml31 = runMusicXml "xsd/musicxml.31.xsd" "src/Fadno/MusicXml/MusicXml31.hs" "Fadno.MusicXml.MusicXml31"
+
+
+runMusicXml :: FilePath -> FilePath -> String -> IO ()
+runMusicXml xsd moduleFile moduleName = do
+  s <- loadMusicXml xsd
   e <- snd <$> runEmit (Env s) mempty (emitSchema s)
-  withFile "src/Fadno/MusicXml/MusicXml20.hs" WriteMode $ \h ->
+  withFile moduleFile WriteMode $ \h ->
       void $ runOut' h $ do
-                  outputHeader "Fadno.MusicXml.MusicXml20"
+                  outputHeader moduleName
                   outputTypes e
 
 
@@ -36,9 +48,9 @@ loadXlinkXmlSchemas = do
   xsd <- loadXsdSchema "xsd/XMLSchema.xsd"
   return (xml <> xlink <> xsd)
 
--- | Load Music XML 2.0 schema
-loadMusicXml20 :: IO Schema
-loadMusicXml20 = do
-  x <- parseFile "xsd/musicxml.20.xsd"
+-- | Load Music XML XSD and deps
+loadMusicXml :: FilePath -> IO Schema
+loadMusicXml xsd = do
+  x <- parseFile xsd
   deps <- loadXlinkXmlSchemas
   return (x <> deps)

src/Fadno/MusicXml/MusicXml20.hs

@@ -18,7 +18,7 @@ import Fadno.Xml.EmitXml
 import qualified Fadno.Xml.XParse as P
 import qualified Control.Applicative as P
 import Control.Applicative ((<|>))
-import Control.Arrow as A
+import qualified Control.Arrow as A
 
 -- | @xs:ID@ /(simple)/
 newtype ID = ID { iD :: NCName }