diff --git a/music-util.cabal b/music-util.cabal --- a/music-util.cabal +++ b/music-util.cabal @@ -1,6 +1,6 @@ name: music-util -version: 0.7 +version: 0.8 cabal-version: >= 1.10 author: Hans Hoglund maintainer: Hans Hoglund diff --git a/src/music-util.hs b/src/music-util.hs --- a/src/music-util.hs +++ b/src/music-util.hs @@ -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 []" + echo $ "usage: music-util []" 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 Reinstall the given package and its dependencies" echo $ " foreach 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