\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}