MusicXML.lhs

\begin{code}
-- |
module Main where

import Text.XML.MusicXML hiding (String)            -- MusicXML package
import System.IO
import Data.Maybe
import System.Environment
import System.Console.GetOpt
import Prelude
\end{code}

\begin{code}
-- |
data Option = List FilePath
            | Help 
            | Version
              deriving (Eq, Show)
options :: [OptDescr Option]
options = [
      Option ['v','V'] ["version"] (NoArg Version) "show version number"
    , Option ['h','H','?'] ["help"] (NoArg Help) "show help"
    , Option ['l','m'] ["manifest"] (ReqArg List "MANIFEST") "manifest file"
    ]
-- |
header :: String -> String
header prog = "Usage: "++ prog ++" [OPTIONS...] FILES..."
-- |
proc :: [Option] -> [String] -> IO ()
proc [] files = main' (zip ([1..]::[Int]) files)
proc ((List file):t) files = do
    list <- readFile file
    proc t (lines list ++ files)
proc (_:t) files = proc t files
\end{code}


\begin{code}
mkoutput :: FilePath -> FilePath
mkoutput = reverse . ("lmx.tuptuo-"++) . drop 4 . reverse
\end{code}

\begin{code}
-- |
put :: String -> IO ()
put msg = putStr msg >> hFlush stdout
putLn :: String -> IO ()
putLn msg = putStrLn msg >> hFlush stdout

putBool :: Bool -> IO ()
putBool True = putStrLn "[Ok]"
putBool False = putStrLn "[Failed]"
\end{code}

\begin{code}
-- |
inout :: FilePath -> IO () 
inout file = do
    putLn ("file: "++show file) >> put "Reading "
    contents <- readFile file 
    r1 <- return (read_CONTENTS read_MusicXMLDoc file contents)
    r2 <- return (case isOK r1 of
                  True -> Just (mkoutput file, fromOK r1); False -> Nothing)
    putBool (isOK r1)
    put "Writing "
    r3 <- return (fmap (\(a,b) -> 
          (a, show_CONTENTS show_MusicXMLDoc b)) r2)
    maybe (return ()) (uncurry writeFile) r3
    putBool (isJust r3)
\end{code}

\begin{code}
-- |
main :: IO ()
main = do
    argv <- getArgs
    prog <- getProgName
    case getOpt Permute options argv of
        (o,n,[]) | Help`elem`o -> putStrLn (usageInfo (header prog) options)
                 | Version`elem`o -> putStrLn (unwords [prog])
                 | otherwise -> proc o n
        (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options)
-- |
main' :: [(Int, FilePath)] -> IO ()
main' [] = return ()
main' ((a,b):t) = do
    putLn ("\nNumber: " ++ show a) >> inout b >> main' t
\end{code}