hamusic-0.1.2: src/MusicTranslate.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 qualified Music.Analysis.MusicXML as IMusicXML
import qualified Music.Analysis.MusicXML.Level3 as Level3
import qualified Music.Analysis.MusicXML.Level4 as Level4
import qualified Music.Analysis.MusicXML.Level5 as Level5
import qualified Music.Analysis.MusicXML2Haskore as MusicXML2Haskore
import qualified Music.Analysis.MusicXML2Abstract as MusicXML2Abstract
import qualified Music.Analysis.MusicXML2ABC as MusicXML2ABC
import qualified Music.Analysis.Abstract2ABC as Abstract2ABC
import Control.Monad
import Data.List
import System.IO
import System.Environment
import System.Console.GetOpt
import System.FilePath
\end{code}

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

\begin{code}
-- |
data Option = InputFormat Format
            | OutputFormat Format
            | Help 
            | Version
              deriving (Eq, Show)
data Format = MusicXML | Abstract | ABC | Lilypond | Haskore | Unknown String
               deriving (Eq, Show)
-- |
isInput :: Option -> Bool
isInput (InputFormat _) = True
isInput _               = False
isOutput :: Option -> Bool
isOutput (OutputFormat _) = True
isOutput _                = False
-- |
importFormat :: String -> Format
importFormat "musicxml" = MusicXML
importFormat "abstract" = Abstract
importFormat "abc"      = ABC
importFormat "lilypond" = Lilypond
importFormat "haskore"  = Haskore
importFormat str        = Unknown str

-- |
options :: [OptDescr Option]
options = [
      Option ['v','V'] ["version"] (NoArg Version) "show version number"
    , Option ['h','H','?'] ["help"] (NoArg Help) "show help"
    , Option ['i'] ["input"] (ReqArg (InputFormat . importFormat) "FORMAT") 
        "input format"
    , Option ['o'] ["output"] (ReqArg (OutputFormat . importFormat) "FORMAT") 
        "output format"
    ] 

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

\begin{code}
-- |
fromError :: MusicXML.Result a -> String
fromError (MusicXML.Error e) = e
fromError (MusicXML.Ok _) = error "internal error"
-- |
forFILES :: [x] -> (x -> IO ()) -> IO ()
forFILES xs f = mapM_ f xs
-- |
todo :: Format -> Format -> IO ()
todo a b = putStrLn     
    ("Can't translate from " ++ show a ++ "to " ++ show b ++ "formats")

\end{code}

\begin{code}
convert :: Format -> Format -> [FilePath] -> IO ()
convert MusicXML Abstract xs = 
    forFILES xs (\x -> do
        musicxml <- MusicXML.read_FILE MusicXML.read_MusicXML_Partwise x
        case MusicXML.isOK musicxml of
            True -> writeFile (replaceExtension x "abs") 
                        ((show . MusicXML2Abstract.mk_Music . 
                                 Level3.abst_Score_Partwise . 
                                 Level4.abst_Score_Partwise . 
                                 Level5.abst_Score_Partwise . 
                                 IMusicXML.abst_Score_Partwise . 
                                 MusicXML.fromOK) musicxml)
            False -> putStrLn (fromError musicxml))
convert MusicXML ABC xs = 
    forFILES xs (\x -> do
        musicxml <- MusicXML.read_FILE MusicXML.read_MusicXML_Partwise x
        case MusicXML.isOK musicxml of
            True -> writeFile (replaceExtension x "abc") 
                        ((show . MusicXML2ABC.mk_Music . 
                                 Level3.abst_Score_Partwise . 
                                 Level4.abst_Score_Partwise . 
                                 Level5.abst_Score_Partwise . 
                                 IMusicXML.abst_Score_Partwise . 
                                 MusicXML.fromOK) musicxml)
            False -> putStrLn (fromError musicxml))
convert MusicXML Haskore xs = do
    forFILES xs (\x -> do 
        musicxml <- MusicXML.read_FILE MusicXML.read_MusicXML_Partwise x
        case MusicXML.isOK musicxml of
            True -> writeFile (replaceExtension x "hs") 
                        ((show . MusicXML2Haskore.partwise2haskore .
                                 MusicXML.fromOK) musicxml)
            False -> putStrLn (fromError musicxml))
convert MusicXML Lilypond xs = do
    let _ = map (flip replaceExtension "ly") xs
    todo MusicXML Lilypond
convert ABC MusicXML xs = do
    let _ = map (flip replaceExtension "xml") xs
    todo ABC MusicXML
convert ABC Abstract xs = do
    let _ = map (flip replaceExtension "abs") xs
    todo ABC Abstract
convert ABC Haskore xs = do
    let _ = map (flip replaceExtension "hs") xs
    todo ABC Haskore
convert ABC Lilypond xs = do
    let _ = map (flip replaceExtension "ly") xs
    todo ABC Lilypond
convert Abstract MusicXML xs = do
    let _ = map (flip replaceExtension "xml") xs
    todo Abstract MusicXML
convert Abstract ABC xs = do
    forFILES xs (\x -> do 
        y <- readFile x
        writeFile (replaceExtension x "abc") 
                  ((show . Abstract2ABC.mk_Music . read) y))
convert Abstract Lilypond xs = do
    let _ = map (flip replaceExtension "ly") xs
    todo Abstract Lilypond
convert Abstract Haskore xs = do
    let _ = map (flip replaceExtension "hs") xs
    todo Abstract Haskore
convert Haskore ABC xs = do
    let _ = map (flip replaceExtension "abc") xs
    todo Haskore ABC
convert Haskore Abstract xs = do
    let _ = map (flip replaceExtension "abs") xs
    todo Haskore Abstract
convert Haskore MusicXML xs = do
    let _ = map (flip replaceExtension "xml") xs
    todo Haskore MusicXML
convert Haskore Lilypond xs = do
    let _ = map (flip replaceExtension "ly") xs
    todo Haskore Lilypond
convert Lilypond MusicXML xs = do
    let _ = map (flip replaceExtension "ly") xs
    todo Lilypond MusicXML
convert Lilypond ABC xs = do
    let _ = map (flip replaceExtension "abc") xs
    todo Lilypond ABC
convert Lilypond Abstract xs = do
    let _ = map (flip replaceExtension "abs") xs
    todo Lilypond Abstract
convert Lilypond Haskore xs = do
    let _ = map (flip replaceExtension "hs") xs
    todo Lilypond Haskore
convert (a@(Unknown _)) b _ = todo a b
convert a (b@(Unknown _)) _ = todo a b
convert a b _ | a == b      = todo a b
              | otherwise   = todo a b

\end{code}

\begin{code}
main :: IO ()
main = do
    argv <- getArgs
    prog <- getProgName
    case getOpt Permute options argv of
        ([InputFormat a, OutputFormat b],n,[]) -> convert a b n
        ([OutputFormat a, InputFormat b],n,[]) -> convert b a n
        (o,n,[]) | Help`elem`o -> putStrLn (usageInfo (header prog) options)
                 | Version`elem`o -> putStrLn (unwords [prog, version])
                 | otherwise -> 
                    putStrLn (unlines n ++ usageInfo (header prog) options)
        (_,_,errs) -> putStrLn (unlines errs ++ usageInfo (header prog) options)
\end{code}