music-util 0.7 → 0.8
raw patch · 2 files changed
+82/−34 lines, 2 files
Files
- music-util.cabal +1/−1
- src/music-util.hs +81/−33
music-util.cabal view
@@ -1,6 +1,6 @@ name: music-util-version: 0.7+version: 0.8 cabal-version: >= 1.10 author: Hans Hoglund maintainer: Hans Hoglund <hans@hanshoglund.se>
src/music-util.hs view
@@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings, CPP #-}+{-# LANGUAGE OverloadedStrings, ViewPatterns, CPP #-} import Control.Applicative import Control.Exception (SomeException, try)@@ -14,6 +14,7 @@ #endif import System.Process (system)+import Control.Monad import qualified Data.List as List import Data.Map (Map) import qualified Data.Map as Map@@ -44,11 +45,11 @@ dependencies :: Gr String String dependencies = mkGraph [+ (-3, "music-pitch-literal") ,+ (-4, "music-dynamics-literal") , (0, "abcnotation") , (1, "musicxml2") , (2, "lilypond") ,- (3, "music-pitch-literal") ,- (4, "music-dynamics-literal") , (5, "music-score") , (6, "music-pitch") , (7, "music-dynamics") ,@@ -60,20 +61,20 @@ (99, "music-docs") ] [- (0, 3, ""),- (0, 4, ""),- (1, 3, ""),- (1, 4, ""),- (2, 3, ""),- (2, 4, ""),- (6, 3, ""),- (7, 4, ""),+ (0, -3, ""),+ (0, -4, ""),+ (1, -3, ""),+ (1, -4, ""),+ (2, -3, ""),+ (2, -4, ""),+ (6, -3, ""),+ (7, -4, ""), (5, 0, ""), (5, 1, ""), (5, 2, ""),- (5, 3, ""),- (5, 4, ""),+ (5, -3, ""),+ (5, -4, ""), (10, 5, ""), (10, 6, ""),@@ -131,7 +132,7 @@ deps = suc dependencies node depNames :: [String]- depNames = catMaybes $ fmap (lab dependencies) deps + depNames = catMaybes $ fmap (lab dependencies) deps @@ -147,23 +148,26 @@ -- echo $ fromString path chdir (fromString path) (main3 args) -main3 args = do- if length args <= 0 then usage else do- if (args !! 0 == "document") then document args else return ()- if (args !! 0 == "install") then install args else return ()- if (args !! 0 == "list") then list args else return ()- if (args !! 0 == "graph") then graph args else return ()- if (args !! 0 == "foreach") then forEach (tail args) else return ()- if (args !! 0 == "setup") then setup args else return ()+main3 [] = usage+main3 (subCmd : args) = do+ if length (subCmd : args) <= 0 then usage else do+ if (subCmd == "document") then document args else return ()+ if (subCmd == "install") then install args else return ()+ if (subCmd == "list") then list args else return ()+ if (subCmd == "graph") then graph args else return ()+ if (subCmd == "foreach") then forEach args else return ()+ if (subCmd == "setup") then setup args else return () usage :: Sh () usage = do- echo $ "usage: music <command> [<args>]"+ echo $ "usage: music-util <command> [<args>]" echo $ "" echo $ "When commands is one of:" echo $ " list Show a list all packages in the Music Suite" echo $ " graph Show a graph all packages in the Music Suite (requires Graphviz)"- echo $ " setup Download all packages (but do not build)"+ echo $ " setup Download all packages and setup sandbox"+ echo $ " setup clone Download all packages"+ echo $ " setup sandbox Setup the sandbox" echo $ " install <package> Reinstall the given package and its dependencies" echo $ " foreach <command> Run a command in each source directory" echo $ " document Generate and upload documentation"@@ -174,22 +178,56 @@ echo "" setup :: [String] -> Sh ()-setup _ = do+setup ("clone":_) = setupClone (return ())+setup ("sandbox":_) = setupSandbox+setup _ = setupClone setupSandbox++setupClone cont = do path <- pwd echo $ "Ready to setup music-suite in path\n " <> unFilePath path echo $ ""- echo $ "Please enter 'ok' to confirm..."- conf <- liftIO $ getLine- when (conf /= "ok") $ echo $ "Aborted"- when (conf == "ok") $ do- mapM_ clonePackage packages+ echo $ "Please enter 'ok' to confirm..."+ conf <- liftIO $ getLine+ if conf /= "ok" then + echo "Aborted" + else do+ forM_ packages clonePackage+ cont return () return () +setupSandbox :: Sh ()+setupSandbox = hasCabalSandboxes >>= (`when` setupSandbox')++setupSandbox' = do+ rm_rf "music-sandbox"+ mkdir "music-sandbox"+ chdir "music-sandbox" $ do+ run "cabal" ["sandbox", "init", "--sandbox", "."]+ forM_ packages $ \p -> do+ run "cabal" ["sandbox", "add-source", "../" <> T.pack p]++ -- Tell cabal to use the sandbox in all music-suite packages.+ -- This is typically only needed for top-level packages such as music-preludes, but no+ -- harm in doing it in all packages.+ forM_ (packages `sans` "music-util") $ \p -> chdir (fromString p) $ do+ run "cabal" ["sandbox", "init", "--sandbox", "../music-sandbox"]+ run "cabal" ["install", "--only-dependencies"]+ run "cabal" ["configure"]+ run "cabal" ["install"]++ return ()++hasCabalSandboxes :: Sh Bool+hasCabalSandboxes = do+ cb <- run (fromString "cabal") [fromString "--version"]+ return $ List.isInfixOf "1.18" . head . lines. T.unpack $ cb++ clonePackage :: String -> Sh () clonePackage name = do echo "======================================================================"- liftIO $ system $ "git clone git@github.com:music-suite/" <> name <> ".git"+ liftIO $ system $ "git clone git@github.com:music-suite/" <> name <> ".git" echo "======================================================================" return () @@ -217,10 +255,12 @@ echo $ fromString name echo "======================================================================" chdir (fromString name) $ do- run_ (fromString cmd) (fmap fromString args)+ run_ (fromString $ substName $ cmd) (fmap (fromString . substName) args)+ where+ substName = rep "MUSIC_PACKAGE" name install :: [String] -> Sh ()-install (_:name:_) = do+install (name:_) = do let all = List.nub $ reverse $ getPackageDeps name -- echo $ show' $ all @@ -232,6 +272,7 @@ mapM reinstall all return () + document :: [String] -> Sh () document args = do @@ -387,3 +428,10 @@ fromLab l' = getFirst . ufold (\(_,n,l,_) -> if l == l' then (<> First (Just n)) else id) mempty +rep :: Eq a => [a] -> [a] -> [a] -> [a]+rep a b s@(x:xs) = if List.isPrefixOf a s+ then b++rep a b (drop (length a) s)+ else x:rep a b xs+rep _ _ [] = []++xs `sans` x = filter (/= x) xs