hamusic-0.1: src/MusicCount.lhs

\begin{code}
-- | 
-- Maintainer : silva.samuel@alumni.uminho.pt
-- Stability  : experimental
-- Portability: portable
-- This module implements 
module Main  where
import qualified Text.XML.MusicXML as MusicXML
--import Music.Analysis.MusicXML2Haskore
import Music.Analysis.MusicXML.Functions
import Control.Monad
import Data.List
import System.IO
import System.Environment
import System.Console.GetOpt
--import System.FilePath
--import Control.Exception (throw, Exception(..))
\end{code}

\begin{code}
-- |
warn :: String -> IO ()
warn msg = putStrLn msg >> hFlush stdout
-- |
version :: String
version = "0.1.1027"
\end{code}

\begin{code}
-- |
data Option = Part | Measure | Note | Sharp | Flat | GraceNote 
--            | MusicXML | Abstract | ABC | Lilypond | Haskore
--            | Format
--            | MusicXML2Abstract
--            | Abstract2ABC
--            | Abstract2Lilypond
--            | MusicXML2Haskore
            | Help 
            | Version
              deriving (Eq, Show)
data Options = Options {part :: Bool, measure :: Bool, note :: Bool} 
data ResultOptions = Result (Maybe Int) (Maybe Int) (Maybe Int)
    deriving (Show)

-- |
options :: [OptDescr Option]
options = [
      Option ['v','V'] ["version"] (NoArg Version) "show version number"
    , Option ['h','H','?'] ["help"] (NoArg Help) "show help"
    , Option ['p'] ["part"] (NoArg Part) "counts part"
    , Option ['m'] ["measure"] (NoArg Measure) "counts measure"
    , Option ['n'] ["note"] (NoArg Note) "counts note"
    
--    , Option ['i'] ["input"] (ReqArg Input "FILE") "input music file"
--    , Option ['o'] ["output"] (ReqArg Output "FILE") "output music file"
--    , Option ['a'] ["abstract"] (NoArg Abstract) "abstract format"
--    , Option ['M'] ["musicxml"] (NoArg MusicXML) "musicxml format"
--    , Option ['H'] ["haskore"] (NoArg Haskore) "haskore format"
--    , Option ['A'] ["abc"] (NoArg ABC) "abc format"
--    , Option ['L'] ["lilypond"] (NoArg Lilypond) "lilypond format"
--    , Option ['c'] ["convert"] opt1
--        "convert input format into output format"
--    , Option [] ["musicxml2abstract"] (NoArg MusicXML2Abstract) 
--        "converts musicxml file into abstract music"
--    , Option [] ["musicxml2haskore"] (NoArg MusicXML2Haskore) 
--        "converts musicxml file into haskore music"
--    , Option [] ["abstract2abc"] (NoArg Abstract2ABC) 
--        "converts abstract music into abc notation"
--    , Option [] ["abstract2lilypond"] (NoArg Abstract2Lilypond) 
--        "converts abstract music into lilypond notation"
    ] 

-- |
header :: String -> String
header prog = "Usage: "++ prog ++" [OPTIONS...] FILES..."
\end{code}

\begin{code}
-- |
counts :: Options -> MusicXML.MusicXMLDoc -> ResultOptions
counts opt m = Result (if part opt then Just (count_part m) else Nothing) 
                      (if measure opt then Just (count_measure m) else Nothing) 
                      (if note opt then Just (count_note m) else Nothing) 
--Nothing Nothing
importMusicXML :: FilePath -> IO (Maybe MusicXML.MusicXMLDoc)
importMusicXML input = do
    musicxml <- MusicXML.read_FILE MusicXML.read_MusicXMLDoc input
    case MusicXML.isOK musicxml of
        True -> return (Just (MusicXML.fromOK musicxml))
        False -> putStrLn ("Can't read "++show input) >> return Nothing

defaultOptions :: Options
defaultOptions = Options {part=False, measure=False, note=False}

convert :: [Option] -> Options -> Options
convert [] = id
convert (Part:xs) = \opts -> convert xs opts {part=True} 
convert (Measure:xs) = \opts -> convert xs opts {measure=True} 
convert (Note:xs) = \opts -> convert xs opts {note=True} 
convert (_:xs) = convert xs
\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, version])
                 | otherwise -> mapM_ (\input -> do
            m <- importMusicXML input
            maybe (return ()) (print . counts (convert o defaultOptions)) m) n
        (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options)
\end{code}

\begin{nocode}
-- |
main :: IO ()
main = do
    argv <- getArgs
    prog <- getProgName
    curdir <- getCurrentDirectory    
    case getOpt Permute options' argv of
       (o,n,[]) | Help'`elem`o -> putStrLn (usageInfo (header prog) options')
                | Version'`elem`o -> putStrLn (unwords [prog, version])
                | Check`elem`o -> 
                    mapM_ (maybe (return ()) 
                            (either (procScriptFile True) setCurrentDirectory) . 
                           parseOptions) (o ++ map Input' n) 
                    >> setCurrentDirectory curdir
                | otherwise -> 
                    mapM_ (maybe (return ()) 
                            (either (procScriptFile False) setCurrentDirectory) . 
                           parseOptions) (o ++ map Input' n) 
                    >> setCurrentDirectory curdir
       (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options')
\end{nocode}