hamusic-0.1.2: src/HaMusic.lhs

\begin{code}
module Main where
import Music.Analysis ()
import Music.Analysis.Script 
import Control.Monad
import Data.List
import System.IO
import System.Directory 
import System.Environment
import System.Console.GetOpt
import Text.XML.HaXml.XmlContent
\end{code}

\begin{code}
-- |
filepath_default :: FilePath
filepath_default = "HaMusic.xml"
-- |
directory_default :: FilePath
directory_default = "."
-- |
warn :: String -> IO ()
warn msg = putStrLn msg >> hFlush stdout
-- |
version :: String
version = "0.1.2"
\end{code}
\begin{nocode}
-- | 
procOpt :: [String] -> IO (Maybe FilePath)
procOpt [] = do
    boolean <- doesFileExist filepath_default
    if boolean then return (Just filepath_default) else return Nothing
procOpt ("-h":t)         = procOpt t
procOpt ("-v":_)         = putStrLn version >> return Nothing
procOpt ("--help":t)     = procOpt t
procOpt ("--version":_)  = putStrLn version >> return Nothing
procOpt (h:t)            = do --warn ("unrecognized option: "++h) >> getOpt t
    boolean <- doesFileExist h
    case boolean of
        True -> return (Just h) 
        False -> warn ("file not found: "++h) >> procOpt t
\end{nocode}

\begin{code}
-- |
data Option = Help | Version | Input FilePath | Path FilePath | Check
    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 ['c'] ["check"] (NoArg Check) "check script"
    , Option ['s','S'] ["script"] opt1 "input file script"
    , Option ['p','P'] ["path"] opt2 "change current path"
    ]
    where opt1 = OptArg (Input . maybe filepath_default id) "FILE"
          opt2 = OptArg (Path . maybe directory_default id) "PATH"
-- |
header :: String -> String
header prog = "Usage: "++ prog ++" [OPTIONS...] FILES..."
\end{code}
\begin{nocode}
procOptions :: [Option] -> Either [FilePath] String
procOptions [] = Left []
procOptions (Version:_) = Right version
procOptions (Help:_) = Right (usageInfo header options)
procOptions ((Input filepath):t) = 
    either (Left . (filepath:)) Right (procOptions t)
procOptions ((Path _):t) = procOptions t
--Left filepath

procArgs :: [FilePath] -> IO ()
procArgs [] = return ()
procArgs (h:t) = procScriptFile h >> procArgs t
--            script <- (fReadXml filepath :: IO Script)
----            maybe (return ()) 
--            (\x -> if null x then return () else setCurrentDirectory x)
--                ((concat.init.groupBy (\ _ y -> y/='/')) filepath)
--            mapM_ procAction ((\(Script x) -> x) script)

--proc (opts, args) = 
--    either (\ x -> procArgs (x++args)) putStrLn (procOptions opts)
\end{nocode}
\begin{code}
-- |
procScriptFile :: Bool -> FilePath -> IO ()
procScriptFile boolean filepath = do
    curdir <- getCurrentDirectory
    script <- fReadXml filepath 
--    maybe (return ())
    (\x -> if null x then return () else setCurrentDirectory x)
            ((concat.init.groupBy (\ _ y -> y/='/')) filepath)
    unless boolean (procScript script)
    setCurrentDirectory curdir
--script <- (fReadXml filepath :: IO Script)
--            maybe (return ()) 
--            (\x -> if null x then return () else setCurrentDirectory x)
--                ((concat.init.groupBy (\ _ y -> y/='/')) filepath)
\end{code}
\begin{nocode}
-- |
parseOptions :: [Option] -> IO ()
parseOptions opts | Help `elem` opts = putStrLn (usageInfo header options)
                  | Version `elem` opts = putStrLn version
                  | otherwise = 
                    mapM_ (maybe (return ()) 
                                (either procScriptFile setCurrentDirectory) . 
                           parseOptions') opts
\end{nocode}
\begin{code}
-- |
parseOptions :: Option -> Maybe (Either FilePath FilePath)
parseOptions (Input filepath) = Just (Left filepath)
parseOptions (Path path) = Just (Right path)
parseOptions _ = Nothing
\end{code}

\begin{nocode}
--compilerOpts :: [String] -> IO ([Flag], [String])
compilerOpts :: [String] -> IO ()
compilerOpts argv = 
    case getOpt Permute options argv of
       (o,n,[]  ) -> either (\ x -> procArgs (x++n)) putStrLn (procOptions o)
       --return (o,n)
       (_,_,errs) -> fail (concat errs ++ usageInfo header options)
       --ioError (userError (concat errs ++ usageInfo header options))
--      where header = "Usage: ic [OPTION...] files..."

\end{nocode}

\begin{code}
-- |
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{code}

\begin{nocode}
-- |
main :: IO ()
main = do
    argv <- getArgs
    case getOpt Permute options argv of
       (o,n,[]  ) -> either (\ x -> procArgs (x++n)) putStrLn (procOptions o)
       (_,_,errs) -> putStrLn (unlines errs ++ usageInfo header options)

--    r1 <- getArgs >>= procOpt 
--    case r1 of
--        Nothing  -> return ()
--        Just r1' -> do 
--            script <- (fReadXml r1' :: IO Script)
--            maybe (return ()) 
--                (\x -> if null x then return () else setCurrentDirectory x)
--                (fmap (concat.init.groupBy (\ _ y -> y/='/')) r1)
--            mapM_ procAction ((\(Script x) -> x) script)

--aux x = do 
--    print x 
--    mapM_ proc ((\(Script y) -> y) x)
\end{nocode}