diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for stack-all +## 0.2 (2021-04-03) +- better error messages when reading snapshot option/arg (TristanCacqueray) +- search parent dirs for stack project dir, like stack +- snapshot options/args can now be in compact ltsXY form as well as lts-XY +- support stack commands and options + ## 0.1.2 (2021-02-05) - --create-config comment line mentions older version - show error for unversioned "stack-lts.yaml" diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -1,158 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Control.Monad.Extra -import Data.Ini.Config -import Data.List.Extra -import Data.Maybe -import qualified Data.Text.IO as T -import SimpleCmd -import SimpleCmdArgs -import System.Directory -import System.Exit -import System.FilePath -import System.IO -import System.Process - -import Paths_stack_all (version) - --- FIXME allow specific snapshots? --- FIXME lts latest -data Snapshot = LTS Int | Nightly - deriving (Eq, Ord) - --- maybeReadSnap "lts16" -readCompactSnap :: String -> Maybe Snapshot -readCompactSnap "nightly" = Just Nightly -readCompactSnap snap = - if "lts" `isPrefixOf` snap then - let major = read (dropPrefix "lts" snap) in Just (LTS major) - else Nothing - --- readSnap "lts-16" -readSnap :: String -> Snapshot -readSnap "nightly" = Nightly -readSnap snap = - if "lts" `isPrefixOf` snap then - let major = read (dropPrefix "lts-" snap) in LTS major - else error' $ "malformed snapshot " ++ snap - -showSnap :: Snapshot -> String -showSnap Nightly = "nightly" -showSnap (LTS ver) = "lts-" ++ show ver - -defaultOldest :: Snapshot -defaultOldest = LTS 11 - -allSnaps :: [Snapshot] -allSnaps = [Nightly, LTS 17, LTS 16, LTS 14, LTS 13, LTS 12, LTS 11, - LTS 10, LTS 9, LTS 8, LTS 6, LTS 5, LTS 4, LTS 2, LTS 1] - -data VersionSpec = DefaultVersions | Oldest Snapshot | AllVersions | VersionList [Snapshot] - -main :: IO () -main = do - hSetBuffering stdout NoBuffering - unlessM (doesFileExist "stack.yaml") $ - error' "no stack.yaml found" - simpleCmdArgs (Just version) "Build over Stackage versions" - "stack-all builds projects easily across different Stackage versions" $ - run <$> - switchWith 'c' "create-config" "Create a project .stack-all file" <*> - switchWith 'd' "debug" "Verbose stack build output on error" <*> - optional (readSnap <$> strOptionWith 'n' "newest" "lts-MAJOR" "Newest LTS release to build from") <*> - optional (strOptionWith 'C' "cmd" "COMMAND" "Specify a stack command [default: build]") <*> - versionSpec - where - versionSpec = - Oldest . readSnap <$> strOptionWith 'o' "oldest" "lts-MAJOR" "Oldest compatible LTS release" <|> - VersionList . map readSnap <$> some (strArg "LTS") <|> - flagWith DefaultVersions AllVersions 'a' "all-lts" "Try to build back to LTS 1 even" - -run :: Bool -> Bool -> Maybe Snapshot -> Maybe String -> VersionSpec -> IO () -run createConfig debug mnewest mcmd versionSpec = do - if createConfig then - case versionSpec of - Oldest oldest -> createStackAll oldest - _ -> error' "creating .stack-all requires --oldest LTS" - else do - versions <- - case versionSpec of - DefaultVersions -> do - oldest <- fromMaybeM (return defaultOldest) readOldestLTS - return $ case mnewest of - Just newest | newest < oldest -> filter (newest >=) allSnaps - _ -> filter (>= oldest) allSnaps - AllVersions -> return allSnaps - Oldest ver -> return $ filter (>= ver) allSnaps - VersionList vers -> return vers - configs <- mapMaybe readStackConf <$> listDirectory "." - let newestFilter = maybe id (filter . (>=)) mnewest - mapM_ (stackBuild configs debug mcmd) (newestFilter versions) - where - readStackConf :: FilePath -> Maybe Snapshot - readStackConf "stack-lts.yaml" = error' "unversioned stack-lts.yaml is unsupported" - readStackConf f = - stripPrefix "stack-" f >>= stripSuffix ".yaml" >>= readCompactSnap - -stackAllFile :: FilePath -stackAllFile = ".stack-all" - -createStackAll :: Snapshot -> IO () -createStackAll snap = do - exists <- doesFileExist stackAllFile - if exists then error' $ stackAllFile ++ " already exists" - else do - let older = - let molder = listToMaybe $ dropWhile (>= snap) allSnaps - in maybe "" (\s -> showSnap s ++ " too old") molder - writeFile stackAllFile $ - "[versions]\n# " ++ older ++ "\noldest = " ++ showSnap snap ++ "\n" - -readOldestLTS :: IO (Maybe Snapshot) -readOldestLTS = do - haveConfig <- doesFileExist stackAllFile - if haveConfig then - Just . readSnap <$> readIniConfig stackAllFile rcParser id - else return Nothing - where - rcParser :: IniParser String - rcParser = - section "versions" $ - fieldOf "oldest" string - - readIniConfig :: FilePath -> IniParser a -> (a -> b) -> IO b - readIniConfig inifile iniparser fn = do - ini <- T.readFile inifile - return $ either error fn $ parseIniFile ini iniparser - -stackBuild :: [Snapshot] -> Bool -> Maybe String -> Snapshot -> IO () -stackBuild configs debug mcmd snap = do - let command = maybe ["build"] words mcmd - config = - case sort (filter (snap <=) configs) of - [] -> [] - (cfg:_) -> ["--stack-yaml", showConfig cfg] - args = ["-v" | debug] ++ ["--resolver", showSnap snap] ++ - config ++ command - if debug - then debugBuild args - else cmd_ "stack" args - putStrLn "" - where - showConfig :: Snapshot -> FilePath - showConfig sn = "stack-" ++ compactSnap sn <.> "yaml" - where - compactSnap :: Snapshot -> String - compactSnap Nightly = "nightly" - compactSnap (LTS ver) = "lts" ++ show ver - - debugBuild :: [String] -> IO () - debugBuild args = do - putStr $ "stack " ++ unwords args - (ret,out,err) <- readProcessWithExitCode "stack" args "" - putStrLn "\n" - unless (null out) $ putStrLn out - unless (ret == ExitSuccess) $ do - -- stack verbose includes info line with all stackages (> 500kbytes) - mapM_ putStrLn $ filter ((<10000) . length) . lines $ err - error' $ showSnap snap ++ " build failed" diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,8 +6,10 @@ ## Usage -`stack-all` runs `stack build` over recent Stackage LTS major versions -and Nightly: by default currently: nightly, lts-16, ..., lts-11. +`stack-all` by default runs `stack build` over +recent Stackage LTS major versions and Nightly +(current default is nightly, lts-17, lts-16, lts-14,... , lts-11) +corresponding to latest major ghc minor verions. Note that stack-all will automatically use `stack-ltsXX.yaml`, even for older lts releases: eg say you have `stack-lts13.yaml` in your project, then it will also be used for building lts-12 (unless you have a `stack-lts12.yaml` config file of course). (Other versioned stack.yaml filenames like stack-ghc-8.8.yaml are not supported currently.) @@ -19,10 +21,16 @@ ``` which can be created with `stack-all -c -o lts-13`. +You can also pass stack commands and options on the command line: eg +``` +$ stack-all test +``` +will run `stack test` over the LTS versions, etc (instead of `stack build`). + Happy stack building! ## Install Run `stack install` or `cabal install` in the source. -## Contribute -See https://github.com/juhp/stack-all +## Contribute or discuss +at https://github.com/juhp/stack-all diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Monad.Extra +import Data.Either +import Data.Ini.Config +import Data.List.Extra +import Data.Maybe +import Data.Tuple (swap) +import Text.Read (readMaybe) +import qualified Data.Text.IO as T +import SimpleCmd +import SimpleCmdArgs +import System.Directory +import System.Exit +import System.FilePath +import System.IO +import System.Process + +import Paths_stack_all (version) + +-- FIXME allow specific snapshots? +-- FIXME lts latest +data Snapshot = LTS Int | Nightly + deriving (Eq, Ord) + +-- readCompactSnap "lts16" +readCompactSnap :: String -> Maybe Snapshot +readCompactSnap "nightly" = Just Nightly +readCompactSnap snap = + if "lts" `isPrefixOf` snap then + case readMaybe (dropPrefix "lts" snap) of + Just major -> Just (LTS major) + Nothing -> error' $ "couldn't parse compact " ++ snap ++ " (expected ltsXX)" + else Nothing + +eitherReadSnap :: String -> Either String Snapshot +eitherReadSnap cs = + case maybeReadSnap cs of + Just s -> Right s + _ -> Left cs + +maybeReadSnap :: String -> Maybe Snapshot +maybeReadSnap "nightly" = Just Nightly +maybeReadSnap snap = + if "lts" `isPrefixOf` snap then + case readMaybe (dropPrefix "lts-" snap) <|> readMaybe (dropPrefix "lts" snap) of + Just major -> Just (LTS major) + Nothing -> Nothing + else Nothing + +-- readSnap "lts-16" +readSnap :: String -> Snapshot +readSnap "nightly" = Nightly +readSnap snap = + case maybeReadSnap snap of + Just s -> s + Nothing -> + error' $ "couldn't parse " ++ snap ++ " (expected lts-XX or ltsXX)" + +showSnap :: Snapshot -> String +showSnap Nightly = "nightly" +showSnap (LTS ver) = "lts-" ++ show ver + +defaultOldest :: Snapshot +defaultOldest = LTS 11 + +allSnaps :: [Snapshot] +allSnaps = [Nightly, LTS 17, LTS 16, LTS 14, LTS 13, LTS 12, LTS 11, + LTS 10, LTS 9, LTS 8, LTS 6, LTS 5, LTS 4, LTS 2, LTS 1] + +data VersionLimit = DefaultLimit | Oldest Snapshot | AllVersions + +main :: IO () +main = do + hSetBuffering stdout NoBuffering + simpleCmdArgs' (Just version) "Build over Stackage versions" + "stack-all builds projects easily across different Stackage versions" $ + run <$> + switchWith 'c' "create-config" "Create a project .stack-all file" <*> + switchWith 'd' "debug" "Verbose stack build output on error" <*> + optional (readSnap <$> strOptionWith 'n' "newest" "lts-MAJOR" "Newest LTS release to build from") <*> + (Oldest . readSnap <$> strOptionWith 'o' "oldest" "lts-MAJOR" "Oldest compatible LTS release" <|> + flagWith DefaultLimit AllVersions 'a' "all-lts" "Try to build back to LTS 1 even") <*> + many (strArg "SNAPSHOT... [COMMAND...]") + +run :: Bool -> Bool -> Maybe Snapshot -> VersionLimit -> [String] -> IO () +run createconfig debug mnewest verlimit verscmd = do + haveSYL <- doesFileExist "stack.yaml" + if not haveSYL + then do + cwdir <- getCurrentDirectory + if cwdir == "/" + then error' "No stack project found" + else setCurrentDirectory ".." >> + run createconfig debug mnewest verlimit verscmd + else + if createconfig then + case verlimit of + Oldest oldest -> createStackAll oldest + _ -> error' "creating .stack-all requires --oldest LTS" + else do + (versions, cs) <- getVersionsCmd + configs <- mapMaybe readStackConf <$> listDirectory "." + let newestFilter = maybe id (filter . (>=)) mnewest + mapM_ (stackBuild configs debug cs) (newestFilter versions) + where + readStackConf :: FilePath -> Maybe Snapshot + readStackConf "stack-lts.yaml" = error' "unversioned stack-lts.yaml is unsupported" + readStackConf f = + stripPrefix "stack-" f >>= stripSuffix ".yaml" >>= readCompactSnap + + getVersionsCmd :: IO ([Snapshot],[String]) + getVersionsCmd = do + let partitionSnaps = swap . partitionEithers . map eitherReadSnap + (verlist,cmds) = partitionSnaps verscmd + versions <- + if null verlist then + case verlimit of + DefaultLimit -> do + oldest <- fromMaybeM (return defaultOldest) readOldestLTS + return $ case mnewest of + Just newest -> + if newest < oldest + then filter (newest >=) allSnaps + else filter (\ s -> s >= oldest && newest >= s) allSnaps + Nothing -> filter (>= oldest) allSnaps + AllVersions -> return allSnaps + Oldest ver -> return $ filter (>= ver) allSnaps + else return verlist + return (versions,if null cmds then ["build"] else cmds) + +stackAllFile :: FilePath +stackAllFile = ".stack-all" + +createStackAll :: Snapshot -> IO () +createStackAll snap = do + exists <- doesFileExist stackAllFile + if exists then error' $ stackAllFile ++ " already exists" + else do + let older = + let molder = listToMaybe $ dropWhile (>= snap) allSnaps + in maybe "" (\s -> showSnap s ++ " too old") molder + writeFile stackAllFile $ + "[versions]\n# " ++ older ++ "\noldest = " ++ showSnap snap ++ "\n" + +readOldestLTS :: IO (Maybe Snapshot) +readOldestLTS = do + haveConfig <- doesFileExist stackAllFile + if haveConfig then + Just . readSnap <$> readIniConfig stackAllFile rcParser id + else return Nothing + where + rcParser :: IniParser String + rcParser = + section "versions" $ + fieldOf "oldest" string + + readIniConfig :: FilePath -> IniParser a -> (a -> b) -> IO b + readIniConfig inifile iniparser fn = do + ini <- T.readFile inifile + return $ either error fn $ parseIniFile ini iniparser + +stackBuild :: [Snapshot] -> Bool -> [String] -> Snapshot -> IO () +stackBuild configs debug command snap = do + let config = + case sort (filter (snap <=) configs) of + [] -> [] + (cfg:_) -> ["--stack-yaml", showConfig cfg] + args = ["-v" | debug] ++ ["--resolver", showSnap snap] ++ + config ++ command + if debug + then debugBuild args + else cmd_ "stack" args + putStrLn "" + where + showConfig :: Snapshot -> FilePath + showConfig sn = "stack-" ++ compactSnap sn <.> "yaml" + where + compactSnap :: Snapshot -> String + compactSnap Nightly = "nightly" + compactSnap (LTS ver) = "lts" ++ show ver + + debugBuild :: [String] -> IO () + debugBuild args = do + putStr $ "stack " ++ unwords args + (ret,out,err) <- readProcessWithExitCode "stack" args "" + putStrLn "\n" + unless (null out) $ putStrLn out + unless (ret == ExitSuccess) $ do + -- stack verbose includes info line with all stackages (> 500kbytes) + mapM_ putStrLn $ filter ((<10000) . length) . lines $ err + error' $ showSnap snap ++ " build failed" diff --git a/stack-all.cabal b/stack-all.cabal --- a/stack-all.cabal +++ b/stack-all.cabal @@ -1,5 +1,5 @@ name: stack-all -version: 0.1.2 +version: 0.2 synopsis: CLI tool for building across Stackage major versions description: Build your Haskell project over Stackage major versions. @@ -15,20 +15,21 @@ extra-doc-files: README.md ChangeLog.md cabal-version: 1.18 -tested-with: GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, + GHC == 8.8.4, GHC == 8.10.2, GHC == 9.0.1 source-repository head type: git location: https://github.com/juhp/stack-all.git executable stack-all - main-is: Main.hs + main-is: src/Main.hs other-modules: Paths_stack_all build-depends: base < 5, config-ini, directory, extra >= 1.6.15, - filepath >= 1.4.2, + filepath, process, simple-cmd >= 0.1.4, simple-cmd-args,