stack-all 0.2.2 → 0.3
raw patch · 6 files changed
+246/−120 lines, 6 filesdep +aesondep +bytestringdep +http-query
Dependencies added: aeson, bytestring, http-query, time, unordered-containers, xdg-basedir
Files
- ChangeLog.md +8/−1
- README.md +3/−3
- src/Main.hs +106/−113
- src/MajorVer.hs +57/−0
- src/Snapshots.hs +60/−0
- stack-all.cabal +12/−3
ChangeLog.md view
@@ -1,4 +1,11 @@-# Revision history for stack-all+# Release history for stack-all++## 0.3 (2021-06-26)+- use hackage.stackage.org/snapshots.json:+ - to determine the latest LTS major version+ - to resolve major LTS version to latest minor snapshot and also print it+- cache snapshots.json locally in ~/.cache/stack-all/ for a few hours+- new --make-lts command to generate a stack-ltsXX.yaml file from newer one ## 0.2.2 (2021-06-07) - create a stack.yaml file if only an .cabal file is found
README.md view
@@ -8,7 +8,7 @@ `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)+(current default is nightly, lts-18, lts-17, lts-16, lts-14,... , lts-11) corresponding to latest major ghc minor versions, using the stack's `--resolver` option. @@ -20,14 +20,14 @@ ### Overriding stack.yaml `stack-all` can use `stack-ltsXX.yaml` files to override the default `stack.yaml` file for particular lts major versions. Note that a `stack-ltsXX.yaml` file-will also be used for earlier lts major versions until+will also be used for older lts major versions until another `stack-ltsYY.yaml` file is found. For example if you have `stack-lts14.yaml` and `stack-lts12.yaml` files in your project, then `stack.yaml` will be used as normal to build nightly, lts-17 and lts-16, but `stack-lts14.yaml` will be used for building lts-14 and lts-13,-and `stack-lts12.yaml` will be used for lts-12, lts-11 (and earlier).+and `stack-lts12.yaml` will be used for lts-12, lts-11 (and older). Since `stack-all` overrides the resolver with `--resolver lts-XX` the exact minor lts version specified in the `stack*.yaml` files doesn't actually matter: `stack-all` always uses the latest minor release of
src/Main.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, CPP #-} import Control.Monad.Extra import Data.Either@@ -6,8 +6,6 @@ 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@@ -15,60 +13,18 @@ import System.FilePath import System.IO import System.Process+import qualified Data.Text.IO as T +import MajorVer 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+import Snapshots -defaultOldest :: Snapshot+defaultOldest :: MajorVer 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 MajorVer | AllVersions -data VersionLimit = DefaultLimit | Oldest Snapshot | AllVersions+data Command = CreateConfig | MakeStackLTS | DefaultRun main :: IO () main = do@@ -76,25 +32,32 @@ 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" <*>+ (flagWith' CreateConfig 'c' "create-config" "Create a project .stack-all file" <|>+ flagWith DefaultRun MakeStackLTS 's' "make-lts" "Create a stack-ltsXX.yaml 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" <|>+ optional (readMajor <$> strOptionWith 'n' "newest" "MAJOR" "Newest LTS release to build from") <*>+ (Oldest . readMajor <$> strOptionWith 'o' "oldest" "MAJOR" "Oldest compatible LTS release" <|> flagWith DefaultLimit AllVersions 'a' "all-lts" "Try to build back to LTS 1 even") <*>- many (strArg "SNAPSHOT... [COMMAND...]")+ many (strArg "MAJORVER... [COMMAND...]") -run :: Bool -> Bool -> Maybe Snapshot -> VersionLimit -> [String] -> IO ()-run createconfig debug mnewest verlimit verscmd = do+run :: Command -> Bool -> Maybe MajorVer -> VersionLimit -> [String] -> IO ()+run command debug mnewest verlimit verscmd = do findStackProjectDir Nothing- 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)+ case command of+ CreateConfig ->+ case verlimit of+ Oldest oldest -> createStackAll oldest+ _ -> error' "creating .stack-all requires --oldest LTS"+ MakeStackLTS -> do+ (versions, _) <- getVersionsCmd+ if null versions+ then error' "--make-lts needs an LTS major version"+ else makeStackLTS versions+ DefaultRun -> do+ (versions, cargs) <- getVersionsCmd+ configs <- mapMaybe readStackConf <$> listDirectory "."+ let newestFilter = maybe id (filter . (>=)) mnewest+ mapM_ (stackBuild configs debug cargs) (newestFilter versions) where findStackProjectDir :: Maybe FilePath -> IO () findStackProjectDir mcwd = do@@ -109,22 +72,21 @@ else do putStrLn "stack.yaml not found" whenJust mcwd setCurrentDirectory- haveCabalFile <- fileWithExtension_ "." ".cabal"+ haveCabalFile <- doesFileExistWithExtension "." ".cabal" if haveCabalFile then do+ -- FIXME take suggested extra-deps into stack.yaml+ -- FIXME stack init content too verbose unlessM (cmdBool "stack" ["init"]) $- writeFile "stack.yaml" "resolver: lts-16.31\n"+ -- FIXME determine latest stable snapshot automatically+ writeFile "stack.yaml" "resolver: lts-17.15\n" else error' "no package/project found" - 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 :: IO ([MajorVer],[String]) getVersionsCmd = do- let partitionSnaps = swap . partitionEithers . map eitherReadSnap- (verlist,cmds) = partitionSnaps verscmd+ let partitionMajors = swap . partitionEithers . map eitherReadMajor+ (verlist,cmds) = partitionMajors verscmd+ allMajors <- getMajorVers versions <- if null verlist then case verlimit of@@ -133,33 +95,39 @@ 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+ then filter (newest >=) allMajors+ else filter (\ s -> s >= oldest && newest >= s) allMajors+ Nothing -> filter (>= oldest) allMajors+ AllVersions -> return allMajors+ Oldest ver -> return $ filter (>= ver) allMajors else return verlist return (versions,if null cmds then ["build"] else cmds) +readStackConf :: FilePath -> Maybe MajorVer+readStackConf "stack-lts.yaml" = error' "unversioned stack-lts.yaml is unsupported"+readStackConf f =+ stripPrefix "stack-" f >>= stripSuffix ".yaml" >>= readCompactMajor+ stackAllFile :: FilePath stackAllFile = ".stack-all" -createStackAll :: Snapshot -> IO ()-createStackAll snap = do+createStackAll :: MajorVer -> IO ()+createStackAll ver = do exists <- doesFileExist stackAllFile if exists then error' $ stackAllFile ++ " already exists" else do+ allMajors <- getMajorVers let older =- let molder = listToMaybe $ dropWhile (>= snap) allSnaps- in maybe "" (\s -> showSnap s ++ " too old") molder+ let molder = listToMaybe $ dropWhile (>= ver) allMajors+ in maybe "" (\s -> showMajor s ++ " too old") molder writeFile stackAllFile $- "[versions]\n# " ++ older ++ "\noldest = " ++ showSnap snap ++ "\n"+ "[versions]\n# " ++ older ++ "\noldest = " ++ showMajor ver ++ "\n" -readOldestLTS :: IO (Maybe Snapshot)+readOldestLTS :: IO (Maybe MajorVer) readOldestLTS = do haveConfig <- doesFileExist stackAllFile if haveConfig then- Just . readSnap <$> readIniConfig stackAllFile rcParser id+ Just . readMajor <$> readIniConfig stackAllFile rcParser id else return Nothing where rcParser :: IniParser String@@ -172,31 +140,50 @@ ini <- T.readFile inifile return $ either error fn $ parseIniFile ini iniparser -stackBuild :: [Snapshot] -> Bool -> [String] -> Snapshot -> IO ()-stackBuild configs debug command snap = do+makeStackLTS :: [MajorVer] -> IO ()+makeStackLTS vers = do+ configs <- mapMaybe readStackConf <$> listDirectory "."+ forM_ vers $ \ ver -> do+ if ver `elem` configs+ then error' $ showConfig ver ++ " already exists!"+ else do+ let mcurrentconfig =+ listToMaybe $ sort (filter (ver <=) configs)+ case mcurrentconfig of+ Nothing -> copyFile "stack.yaml" (showConfig ver)+ Just conf -> copyFile (showConfig conf) (showConfig ver)+ whenJustM (latestSnapshot ver) $ \latest ->+ cmd_ "sed" ["-i", "-e", "s/\\(resolver:\\) .*/\\1 " ++ latest ++ "/", showConfig ver]++showConfig :: MajorVer -> FilePath+showConfig sn = "stack-" ++ compactMajor sn <.> "yaml"+ where+ compactMajor :: MajorVer -> String+ compactMajor Nightly = "nightly"+ compactMajor (LTS ver) = "lts" ++ show ver++stackBuild :: [MajorVer] -> Bool -> [String] -> MajorVer -> IO ()+stackBuild configs debug command ver = do let config =- case sort (filter (snap <=) configs) of+ case sort (filter (ver <=) configs) of [] -> [] (cfg:_) -> ["--stack-yaml", showConfig cfg]- opts = ["-v" | debug] ++ ["--resolver", showSnap snap] ++- config- if debug- then debugBuild $ opts ++ command- else do- ok <- cmdBool "stack" $ opts ++ command- unless ok $ do- putStr "\nsnapshot-pkg-db: "- cmd_ "stack" $ "--silent" : opts ++ ["path", "--snapshot-pkg-db"]- error' $ "failed for " ++ showSnap snap- putStrLn ""+ latest <- latestSnapshot ver+ case latest of+ Nothing -> error' $ "no snapshot not found for " ++ showMajor ver+ Just minor -> do+ let opts = ["-v" | debug] ++ ["--resolver", minor] ++ config+ putStrLn $ "# " ++ minor+ if debug+ then debugBuild $ opts ++ command+ else do+ ok <- cmdBool "stack" $ opts ++ command+ unless ok $ do+ putStr "\nsnapshot-pkg-db: "+ cmd_ "stack" $ "--silent" : opts ++ ["path", "--snapshot-pkg-db"]+ error' $ "failed for " ++ showMajor ver+ 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@@ -206,7 +193,7 @@ 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"+ error' $ showMajor ver ++ " build failed" -- taken from cabal-rpm FileUtils:@@ -215,7 +202,7 @@ -> String -- file extension -> IO [FilePath] filesWithExtension dir ext =- filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir+ filter (ext `isExtensionOf`) <$> listDirectory dir -- looks in dir for a unique file with given extension fileWithExtension :: FilePath -- directory@@ -229,6 +216,12 @@ _ -> putStrLn ("More than one " ++ ext ++ " file found!") >> return Nothing -- looks in current dir for a unique file with given extension-fileWithExtension_ :: FilePath -> String -> IO Bool-fileWithExtension_ dir ext =+doesFileExistWithExtension :: FilePath -> String -> IO Bool+doesFileExistWithExtension dir ext = isJust <$> fileWithExtension dir ext++#if !MIN_VERSION_filepath(1,4,2)+isExtensionOf :: String -> FilePath -> Bool+isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions+isExtensionOf ext = isSuffixOf ('.':ext) . takeExtensions+#endif
+ src/MajorVer.hs view
@@ -0,0 +1,57 @@+module MajorVer (+ MajorVer(..),+ eitherReadMajor,+ maybeReadMajor,+ readCompactMajor,+ readMajor,+ showMajor+ )+where++import Control.Applicative+import Data.List.Extra+import SimpleCmd (error')+import Text.Read (readMaybe)++-- FIXME allow specific snapshots?+-- FIXME support "lts"?+data MajorVer = LTS Int | Nightly+ deriving (Eq, Ord)++maybeReadMajor :: String -> Maybe MajorVer+maybeReadMajor "nightly" = Just Nightly+maybeReadMajor ver =+ if "lts" `isPrefixOf` ver then+ case readMaybe (dropPrefix "lts-" ver) <|> readMaybe (dropPrefix "lts" ver) of+ Just major -> Just (LTS major)+ Nothing -> Nothing+ else Nothing++-- readMajor "lts-16"+readMajor :: String -> MajorVer+readMajor "nightly" = Nightly+readMajor ver =+ case maybeReadMajor ver of+ Just s -> s+ Nothing ->+ error' $ "couldn't parse " ++ ver ++ " (expected lts-XX or ltsXX)"++-- readCompactMajor "lts16"+readCompactMajor :: String -> Maybe MajorVer+readCompactMajor "nightly" = Just Nightly+readCompactMajor ver =+ if "lts" `isPrefixOf` ver then+ case readMaybe (dropPrefix "lts" ver) of+ Just major -> Just (LTS major)+ Nothing -> error' $ "couldn't parse compact " ++ ver ++ " (expected ltsXX)"+ else Nothing++eitherReadMajor :: String -> Either String MajorVer+eitherReadMajor cs =+ case maybeReadMajor cs of+ Just s -> Right s+ _ -> Left cs++showMajor :: MajorVer -> String+showMajor Nightly = "nightly"+showMajor (LTS ver) = "lts-" ++ show ver
+ src/Snapshots.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module Snapshots (+ getMajorVers,+ latestSnapshot+ )+where++import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List.Extra+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import Network.HTTP.Query+import SimpleCmd (error')+import System.Directory+import System.Environment.XDG.BaseDir+import System.FilePath++import MajorVer++excludedMajors :: [MajorVer]+excludedMajors = [LTS 15, LTS 7, LTS 3, LTS 0]++getMajorVers :: IO [MajorVer]+getMajorVers = do+ obj <- getSnapshots+ return $ reverse . sort $ map (readMajor . T.unpack) (H.keys obj \\ ["lts"]) \\ excludedMajors++latestSnapshot :: MajorVer -> IO (Maybe String)+latestSnapshot ver = do+ lookupKey (T.pack (showMajor ver)) <$> getSnapshots++-- FIXME handle network failure+getSnapshots :: IO Object+getSnapshots = do+ file <- getUserCacheFile "stack-all" "snapshots.json"+ exists <- doesFileExist file+ unless exists $ do+ putStrLn $ "Creating " ++ file ++ " ..."+ createDirectoryIfMissing True (takeDirectory file)+ recent <- do+ if exists then do+ ts <- getModificationTime file+ t <- getCurrentTime+ -- < 3 hours+ return $ diffUTCTime t ts < 10000+ else return False+ if recent+ then do+ eobj <- eitherDecode <$> B.readFile file+ case eobj of+ Left err -> error' err+ Right obj -> return obj+ else do+ obj <- webAPIQuery "http://haddock.stackage.org/snapshots.json" []+ B.writeFile file $ encode obj+ return obj
stack-all.cabal view
@@ -1,5 +1,5 @@ name: stack-all-version: 0.2.2+version: 0.3 synopsis: CLI tool for building across Stackage major versions description: Build your Haskell project over Stackage major LTS versions.@@ -23,17 +23,26 @@ location: https://github.com/juhp/stack-all.git executable stack-all- main-is: src/Main.hs+ main-is: Main.hs other-modules: Paths_stack_all+ MajorVer+ Snapshots+ hs-source-dirs: src build-depends: base < 5,+ aeson,+ bytestring, config-ini, directory >= 1.2.5, extra >= 1.6.15, filepath,+ http-query, process, simple-cmd >= 0.1.4, simple-cmd-args,- text+ text,+ time,+ unordered-containers,+ xdg-basedir default-language: Haskell2010 ghc-options: -Wall if impl(ghc >= 8.0)