\begin{code}
module Text.XML.MusicXML (
module Text.XML.MusicXML,
module Text.XML.MusicXML.Common,
module Text.XML.MusicXML.Attributes,
module Text.XML.MusicXML.Identity,
module Text.XML.MusicXML.Barline,
module Text.XML.MusicXML.Link,
module Text.XML.MusicXML.Direction,
module Text.XML.MusicXML.Layout,
module Text.XML.MusicXML.Note,
module Text.XML.MusicXML.Score,
module Text.XML.MusicXML.Partwise,
module Text.XML.MusicXML.Timewise,
) where
import Prelude (IO, Int, String, FilePath,
Monad(..), Show(..), Eq(..), Ord(..),
Maybe(..), Bool(..),
either, maybe, otherwise, fromEnum, snd, mapM,
readFile, writeFile,
(.), (++), (+))
import qualified Data.Map as Map
import Control.Monad (MonadPlus(..))
import System.Time (CalendarTime(..),
getClockTime, toCalendarTime)
import System.Directory (doesFileExist)
import Text.PrettyPrint.HughesPJ
import Text.XML.HaXml.Types
import Text.XML.HaXml.Parse (xmlParse')
import Text.XML.HaXml.Pretty (document)
import Text.XML.HaXml.Posn (Posn, noPos)
import Text.XML.MusicXML.Common hiding
( Tenths, read_Tenths, show_Tenths,
Directive, read_Directive, show_Directive)
import Text.XML.MusicXML.Attributes
import Text.XML.MusicXML.Barline
import Text.XML.MusicXML.Link
import Text.XML.MusicXML.Direction
import Text.XML.MusicXML.Identity
import Text.XML.MusicXML.Layout
import Text.XML.MusicXML.Note
import Text.XML.MusicXML.Score hiding
(Opus, read_Opus, show_Opus)
import Text.XML.MusicXML.Partwise hiding
(doctype, Part, read_Part, show_Part,
Measure, read_Measure, show_Measure)
import Text.XML.MusicXML.Timewise hiding
(doctype, Part, read_Part, show_Part,
Measure, read_Measure, show_Measure)
import Text.XML.MusicXML.Opus hiding
(doctype)
import Text.XML.MusicXML.Container hiding
(doctype)
import qualified Text.XML.MusicXML.Partwise as Partwise
import qualified Text.XML.MusicXML.Timewise as Timewise
import qualified Text.XML.MusicXML.Opus as Opus
import qualified Text.XML.MusicXML.Container as Container
\end{code}
\begin{code}
data ScoreDoc = Partwise Score_Partwise
| Timewise Score_Timewise
deriving (Eq, Show)
data MusicXMLDoc = Score ScoreDoc
| Opus Opus
| Container Container
deriving (Eq, Show)
data MusicXMLRec = MusicXMLRec (Map.Map FilePath MusicXMLDoc)
deriving (Eq, Show)
\end{code}
\begin{code}
read_DOCUMENT :: StateT Result [Content Posn] a -> Document Posn -> Result a
read_DOCUMENT r (Document _ _ x _) = stateT r [CElem x noPos] >>= (return.snd)
read_MusicXML_Partwise :: Document Posn -> Result Score_Partwise
read_MusicXML_Partwise = read_DOCUMENT read_Score_Partwise
read_MusicXML_Timewise :: Document Posn -> Result Score_Timewise
read_MusicXML_Timewise = read_DOCUMENT read_Score_Timewise
read_MusicXML_Opus :: Document Posn -> Result Opus
read_MusicXML_Opus = read_DOCUMENT read_Opus
read_MusicXML_Container :: Document Posn -> Result Container
read_MusicXML_Container = read_DOCUMENT read_Container
show_DOCUMENT :: DocTypeDecl -> (t -> [Content i]) -> t -> Result (Document i)
show_DOCUMENT doct f doc =
case f doc of
[(CElem processed _)] ->
return (Document (Prolog (Just xmldecl) []
(Just doct) []) [] processed [])
_ -> fail "internal error"
show_MusicXML_Partwise :: Score_Partwise -> Result (Document ())
show_MusicXML_Partwise =
show_DOCUMENT Partwise.doctype show_Score_Partwise
show_MusicXML_Timewise :: Score_Timewise -> Result (Document ())
show_MusicXML_Timewise =
show_DOCUMENT Partwise.doctype show_Score_Timewise
show_MusicXML_Opus :: Opus -> Result (Document ())
show_MusicXML_Opus x =
show_DOCUMENT Opus.doctype show_Opus x
show_MusicXML_Container :: Container -> Result (Document ())
show_MusicXML_Container x =
show_DOCUMENT Container.doctype show_Container x
update_MusicXML_Partwise :: ([Software], Encoding_Date) ->
Score_Partwise -> Score_Partwise
update_MusicXML_Partwise = update_Score_Partwise
update_MusicXML_Timewise :: ([Software], Encoding_Date) ->
Score_Timewise -> Score_Timewise
update_MusicXML_Timewise = update_Score_Timewise
\end{code}
\begin{code}
read_MusicXMLDoc :: Document Posn -> Result MusicXMLDoc
read_MusicXMLDoc doc =
(read_DOCUMENT read_Score_Partwise doc >>= return .Score .Partwise) `mplus`
(read_DOCUMENT read_Score_Timewise doc >>= return .Score .Timewise) `mplus`
(read_DOCUMENT read_Opus doc >>= return . Opus) `mplus`
(read_DOCUMENT read_Container doc >>= return . Container) `mplus`
fail "<score-partwise> or <score-timewise> or <opus> or <container>"
show_MusicXMLDoc :: MusicXMLDoc -> Result (Document ())
show_MusicXMLDoc (Score (Partwise doc)) = show_MusicXML_Partwise doc
show_MusicXMLDoc (Score (Timewise doc)) = show_MusicXML_Timewise doc
show_MusicXMLDoc (Opus doc) = show_MusicXML_Opus doc
show_MusicXMLDoc (Container doc) = show_MusicXML_Container doc
update_MusicXMLDoc :: ([Software], Encoding_Date) ->
MusicXMLDoc -> MusicXMLDoc
update_MusicXMLDoc x (Score (Partwise doc)) =
Score (Partwise (update_MusicXML_Partwise x doc))
update_MusicXMLDoc x (Score (Timewise doc)) =
Score (Timewise (update_MusicXML_Timewise x doc))
update_MusicXMLDoc _ y = y
read_MusicXMLRec :: FilePath -> IO (Map.Map FilePath MusicXMLDoc)
read_MusicXMLRec f = do
x <- read_FILE read_MusicXMLDoc f >>= \a -> return (f, a)
case isOK (snd x) of
True -> do
xs <- mapM (\f' -> read_FILE read_MusicXMLDoc f'
>>= \a -> return (f', a))
(Text.XML.MusicXML.getFiles (fromOK (snd x)))
return (Map.map fromOK (Map.filter isOK (Map.fromList (x:xs))))
False -> return (Map.empty)
\end{code}
\begin{code}
read_CONTENTS :: (Document Posn -> Result a) ->
FilePath -> Prelude.String -> Result a
read_CONTENTS f filepath contents =
either fail f (xmlParse' filepath contents)
show_CONTENTS :: (a -> Result (Document i)) -> a -> Prelude.String
show_CONTENTS f musicxml =
maybe (fail "undefined error")
(renderStyle (Style LeftMode 100 1.5) . document)
((toMaybe . f) musicxml)
read_FILE :: (Document Posn -> Result a) -> FilePath -> IO (Result a)
read_FILE f filepath = do
exists <- doesFileExist filepath
case exists of
True -> readFile filepath >>= return . (read_CONTENTS f) filepath
False -> (return . fail) ("no file: " ++ show filepath)
show_FILE :: (a -> Result (Document i)) -> FilePath -> a -> IO ()
show_FILE f filepath musicxml =
writeFile filepath (show_CONTENTS f musicxml)
\end{code}
\begin{code}
xmldecl :: XMLDecl
xmldecl = XMLDecl "1.0" Nothing Nothing
getFiles :: MusicXMLDoc -> [FilePath]
getFiles (Score _) = []
getFiles (Opus x) = Text.XML.MusicXML.Opus.getFiles x
getFiles (Container x) = Text.XML.MusicXML.Container.getFiles x
toMaybe :: Result a -> Maybe a
toMaybe (Ok x) = Just x
toMaybe (Error _) = Nothing
getTime :: IO Encoding_Date
getTime = getClockTime >>= toCalendarTime >>=
return . (\(CalendarTime yyyy mm dd _ _ _ _ _ _ _ _ _) ->
show4 yyyy ++ "-" ++ show2 (fromEnum mm + 1) ++ "-" ++ show2 dd)
show2, show3, show4 :: Int -> Prelude.String
show2 x | (x < 0) = show2 (x)
| otherwise = case show x of; [a] -> '0':a:[]; y -> y
show3 x | (x < 0) = show3 (x)
| otherwise = case show2 x of; [a,b] -> '0':a:b:[]; y -> y
show4 x | (x < 0) = show4 (x)
| otherwise = case show3 x of; [a,b,c] -> '0':a:b:c:[]; y -> y
\end{code}
\begin{verbatim}
getTime :: IO Prelude.String
getTime = getCurrentTime >>= return . show . utctDay
\end{verbatim}