iridium 0.1.5.7 → 0.1.5.8
raw patch · 8 files changed
+174/−101 lines, 8 filesdep +HTTPdep +aesondep +network-uridep −http-conduitdep −xmlhtmldep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: HTTP, aeson, network-uri
Dependencies removed: http-conduit, xmlhtml
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Paths_iridium: getDynLibDir :: IO FilePath
- Development.Iridium.Hackage: retrieveLatestVersion :: (MonadIO m, MonadMultiState LogState m, MonadPlus m) => String -> String -> m (Maybe String)
+ Development.Iridium.Hackage: retrieveLatestVersion :: (MonadIO m, MonadMultiState LogState m, MonadPlus m) => String -> String -> m (Maybe Version)
Files
- ChangeLog.md +5/−0
- data/default-iridium.yaml +1/−0
- iridium.cabal +5/−4
- src-main/Main.hs +44/−33
- src/Development/Iridium.hs +1/−8
- src/Development/Iridium/Checks.hs +61/−13
- src/Development/Iridium/ExternalProgWrappers.hs +1/−1
- src/Development/Iridium/Hackage.hs +56/−42
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for iridium +## 0.1.5.8 -- 2018-10-02++ * Add support for -Wcompat+ * Reduce dependency footprint by using json endpoint of hackage interface+ ## 0.1.5.7 -- 2017-08-01 * Adapt for cabal-2.0 - Note that this is a breaking change; uploading with
data/default-iridium.yaml view
@@ -64,6 +64,7 @@ enabled: True compiler-warnings: enabled: True+ enable-compat: True # whitelist: [only, these, tests] # not supported yet # blacklist: [omit, these, tests] # not supported yet
iridium.cabal view
@@ -1,5 +1,5 @@ name: iridium-version: 0.1.5.7+version: 0.1.5.8 synopsis: Automated Local Cabal Package Testing and Uploading license: BSD3 license-file: LICENSE@@ -71,7 +71,7 @@ -- other-modules: -- other-extensions: build-depends:- { base >=4.7 && <4.11+ { base >=4.8 && <4.11 , lifted-base >=0.2.3.6 && <0.3 , yaml >=0.8.16 && <0.9 , turtle >=1.3.0 && <1.4@@ -82,8 +82,9 @@ , unordered-containers >=0.2.5.1 && <0.3 , multistate >=0.7.0.0 && <0.8 , Cabal >=1.22.5.0 && <1.25- , http-conduit >=2.1.8 && <2.2- , xmlhtml >=0.2.3.4 && <0.3+ , aeson >=1.4 && <1.5+ , network-uri >=2.6 && <2.7+ , HTTP >=4000.3 && <4000.4 , foldl >=1.1.5 && <1.3 , bytestring >=0.10.4.0 && <0.11 , tagged >=0.8.3 && <0.9
src-main/Main.hs view
@@ -29,8 +29,11 @@ import Paths_iridium +import Control.Exception+import Data.Functor + data Option = OptionHelp | OptionVersion@@ -51,38 +54,46 @@ main = do args <- System.Environment.getArgs let (opts, others, errs) = GetOpt.getOpt GetOpt.Permute optDescrs args- _ <- runMaybeT $ runMultiRWSTNil_ $ withMultiState initialLogState $ do- let- printHelp = do- liftIO $ putStrLn $ GetOpt.usageInfo initNote optDescrs- mzero- printVersion = do- liftIO $ putStrLn $ "iridium version "- ++ showVersion version- ++ ", (c) 2016 Lennart Spitzner"- mzero- when (not $ null errs) printHelp- when (not $ null others) printHelp- when (OptionHelp `elem` opts) printHelp- when (OptionVersion `elem` opts) printVersion- let verbosity = length $ filter (==OptionVerbose) $ opts- let levels = [ LogLevelSilent- , LogLevelPrint- , LogLevelDebug- , LogLevelTrace- , LogLevelWarn- , LogLevelError- , LogLevelThread- ]- ++ [ LogLevelInfo | verbosity > 0 ]- ++ [ LogLevelInfoVerbose | verbosity > 1 ]+ let catcher f = (f $> ()) `catch` \e -> putStrLn "" >> print (e :: ErrorCall)+ _ <-+ catcher $ runMaybeT $ runMultiRWSTNil_ $ withMultiState initialLogState $ do+ let printHelp = do+ liftIO $ putStrLn $ GetOpt.usageInfo initNote optDescrs+ mzero+ printVersion = do+ liftIO+ $ putStrLn+ $ "iridium version "+ ++ showVersion version+ ++ ", (c) 2016 Lennart Spitzner"+ mzero+ when (not $ null errs) printHelp+ when (not $ null others) printHelp+ when (OptionHelp `elem` opts) printHelp+ when (OptionVersion `elem` opts) printVersion+ let verbosity = length $ filter (==OptionVerbose) $ opts+ let levels =+ [ LogLevelSilent+ , LogLevelPrint+ , LogLevelDebug+ , LogLevelTrace+ , LogLevelWarn+ , LogLevelError+ , LogLevelThread+ ]+ ++ [ LogLevelInfo | verbosity > 0 ]+ ++ [ LogLevelInfoVerbose | verbosity > 1 ] ++ [ LogLevelInfoVerboser | verbosity > 2 ]- ++ [ LogLevelInfoSpam | verbosity > 3 ]- setLogMask levels- let argConfig = if OptionDryRun `elem` opts- then Yaml.Object $ HM.singleton (Text.pack "process")- $ Yaml.Object $ HM.singleton (Text.pack "dry-run")- $ Yaml.Bool $ True- else Yaml.Object $ HM.empty- iridiumMain argConfig+ ++ [ LogLevelInfoSpam | verbosity > 3 ]+ setLogMask levels+ let argConfig = if OptionDryRun `elem` opts+ then+ Yaml.Object+ $ HM.singleton (Text.pack "process")+ $ Yaml.Object+ $ HM.singleton (Text.pack "dry-run")+ $ Yaml.Bool+ $ True+ else Yaml.Object $ HM.empty+ iridiumMain argConfig return ()
src/Development/Iridium.hs view
@@ -108,14 +108,7 @@ $ PackageDescription.packageDescription $ packageDesc urlStr <- configReadStringM ["setup", "remote-server"]- latestVersionStrM <- retrieveLatestVersion urlStr pkgName- let latestVersionM = latestVersionStrM >>= \latestVersionStr ->- let parseResults = readP_to_S parseVersion latestVersionStr- in fmap fst- $ flip find parseResults- $ \r -> case r of- (_, "") -> True- _ -> False+ latestVersionM <- retrieveLatestVersion urlStr pkgName pushLog LogLevelInfoVerbose $ "remote version: " ++ show (liftM showVersion latestVersionM) configDecideStringM ["repository", "type"] [ (,) "none" $ do
src/Development/Iridium/Checks.hs view
@@ -21,7 +21,7 @@ import qualified Data.Text.IO as Text.IO import qualified Turtle as Turtle import qualified Control.Foldl as Foldl-import qualified Network.HTTP.Conduit as HTTP+import qualified Network.HTTP as HTTP import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as ByteStringL @@ -36,10 +36,11 @@ import Data.Text ( Text ) import Data.Text.Encoding import Distribution.PackageDescription-import Data.Maybe ( maybeToList )+import Data.Maybe ( maybeToList, fromMaybe ) import Data.ByteString ( ByteString ) import qualified Data.ByteString as ByteString import Filesystem.Path.CurrentOS hiding ( null )+import Data.List ( isPrefixOf ) import qualified Distribution.Package import Distribution.Version@@ -74,6 +75,9 @@ "cabal" -> boolToError $ runCheck "Checking package validity" $ do mzeroToFalse $ runCommandSuccessCabal ["check"]+ "cabal-new" -> boolToError $ runCheck "Checking package validity" $ do+ mzeroToFalse $+ runCommandSuccessCabal ["check"] "stack" -> do -- stack has no "check". -- and no "upload --dry-run either."@@ -258,24 +262,32 @@ checks werror = do buildtool <- configReadStringM ["setup", "buildtool"] testsEnabled <- configIsEnabledM ["checks", "testsuites"]+ shouldCompat <- do+ c <- configIsTrueMaybeM ["checks", "compiler-warnings", "enable-compat"]+ pure $ fromMaybe False c case buildtool of "cabal" -> mzeroToFalse $ do let testsArg = ["--enable-tests" | testsEnabled] let werrorArg = ["--ghc-options=\"-Werror\"" | werror] ++ ["--ghc-options=\"-w\"" | not werror]+ let wcompatArg = if shouldCompat+ then ["--ghc-options=\"-Wcompat\""]+ else [] withDefaultCompiler <- createDefaultCompilerFlag runCommandSuccessCabal ["clean"] runCommandSuccessCabal $ ["install"] ++ withDefaultCompiler ++ ["--dep"] ++ testsArg- runCommandSuccessCabal $ ["configure"] ++ withDefaultCompiler ++ testsArg ++ werrorArg+ runCommandSuccessCabal $ ["configure"] ++ withDefaultCompiler ++ testsArg ++ werrorArg ++ wcompatArg runCommandSuccessCabal ["build"] when testsEnabled $ runCommandSuccessCabal ["test"] return True+ "cabal-new" ->+ error "compile not supported in cabal-new" "stack" -> do pushLog LogLevelError "TODO: stack build" mzero- _ -> mzero+ _ -> error "strange buildtool" documentation :: ( MonadIO m@@ -297,10 +309,12 @@ runCommandSuccessCabal $ ["install", "--dep"] ++ withDefaultCompiler runCommandSuccessCabal $ ["configure"] ++ withDefaultCompiler runCommandSuccessCabal $ ["haddock"]+ "cabal-new" ->+ error "documentation not supported with cabal-new!" "stack" -> do pushLog LogLevelError "TODO: stack build" return False- _ -> error "lkajsdlkjasd"+ _ -> error "strange buildtool" compileVersions :: forall m@@ -357,23 +371,47 @@ pushLog LogLevelError $ "Expected string in config for " ++ show confList mzero Just x -> return x+ shouldCompat <- do+ c <- configIsTrueMaybeM ["checks", "compiler-warnings", "enable-compat"]+ pure $ case c of+ Just True -> not $ ("ghc-7" `isPrefixOf` compilerStr)+ _ -> False mzeroToFalse $ do let testsArg = ["--enable-tests" | testsEnabled] let werrorArg = ["--ghc-options=\"-Werror\"" | werror] ++ ["--ghc-options=\"-w\"" | not werror]+ let wcompatArg = if shouldCompat+ then ["--ghc-options=\"-Wcompat\""]+ else [] runCommandSuccessCabal ["clean"] runCommandSuccessCabal $ ["install", "--dep", "-w" ++ compilerPath] ++ testsArg runCommandSuccessCabal $ ["configure", "-w" ++ compilerPath] ++ testsArg ++ werrorArg+ ++ wcompatArg runCommandSuccessCabal ["build"] when testsEnabled $ runCommandSuccessCabal ["test"]+ "cabal-new" -> do+ let confList = ["setup", "compiler-paths", compilerStr]+ compilerPathMaybe <- configReadStringMaybeM confList+ compilerPath <- case compilerPathMaybe of+ Nothing -> do+ pushLog LogLevelError $ "Expected string in config for " ++ show confList+ mzero+ Just x -> return x+ mzeroToFalse $ do+ let testsArg = ["--enable-tests" | testsEnabled]+ Turtle.rmtree (Turtle.fromString "dist-newstyle/cache")+ runCommandSuccessCabal $ ["new-build", "--project-file=cabal.project." ++ compilerStr]+ ++ testsArg+ when testsEnabled $+ runCommandSuccessCabal $ ["new-test", "-w" ++ compilerPath] ++ testsArg "stack" -> do pushLog LogLevelError "TODO: stack build" mzero- _ -> mzero+ _ -> error "strange buildtool" } upperBoundsStackage@@ -410,8 +448,7 @@ cabalConfigContents <- fetchCabalConfig urlStr pName <- liftM (Text.pack . (\(Distribution.Package.PackageName n) -> n)) askPackageName let filteredLines = filter (not . (pName `Text.isInfixOf`))- $ Text.lines- $ decodeUtf8 cabalConfigContents+ $ Text.lines cabalConfigContents -- pushLog LogLevelDebug $ "Writing n lines to cabal.config: " ++ show (length filteredLines) liftIO $ Text.IO.writeFile (encodeString cabalConfigPath) (Text.unlines filteredLines) let testsArg = ["--enable-tests" | testsEnabled]@@ -448,21 +485,27 @@ "stack" -> do pushLog LogLevelError "TODO: stack upper bound check" mzero- _ -> mzero+ _ -> error "strange buildtool" where fetchCabalConfig :: forall m0 . ( MonadIO m0 , MonadMultiState LogState m0+ , MonadPlus m0 ) => String- -> m0 ByteString+ -> m0 Text fetchCabalConfig urlStr = do pushLog LogLevelInfoVerbose $ "Fetching up-to-date cabal.config from " ++ urlStr -- TODO: exception handling- r <- HTTP.simpleHttp urlStr- return $ ByteString.concat $ ByteStringL.toChunks $ r+ e <- liftIO $ HTTP.simpleHTTP (HTTP.getRequest urlStr)+ case e of+ Left err -> do+ pushLog LogLevelError+ $ "Error: failed fetching stackage cabal.config! " ++ show err+ mzero+ Right r -> return $ Text.pack $ HTTP.rspBody r -- url <- case URI.parseURI urlStr of -- Nothing -> do -- pushLog LogLevelError "bad URI"@@ -503,7 +546,12 @@ let sdistName = pName ++ "-" ++ currentVersionStr ++ ".tar.gz" withDefaultCompiler <- createDefaultCompilerFlag runCommandSuccessCabal $ ["install", "dist/" ++ sdistName] ++ withDefaultCompiler+ "cabal-new" -> error "not supported in cabal-new"+ -- mzeroToFalse $ do+ -- runCommandSuccessCabal ["sdist"]+ -- Turtle.rmtree (Turtle.fromString "dist-newstyle/cache")+ -- runCommandSuccessCabal $ ["new-build", "--project-file=cabal.project.disttest"] "stack" -> do pushLog LogLevelError "TODO: stack upper bound check" mzero- _ -> mzero+ _ -> error "strange buildtool"
src/Development/Iridium/ExternalProgWrappers.hs view
@@ -87,6 +87,7 @@ -> m () runCommandSuccess c ps = falseToMZero $ do let infoStr = c ++ " " ++ intercalate " " ps+ pushLog LogLevelInfo $ infoStr withStack infoStr $ do outListRef <- liftIO $ newIORef [] exitCode <- withStack "" $ do -- the additional stack elem is for@@ -112,7 +113,6 @@ case exitCode of ExitSuccess -> do- pushLog LogLevelInfo $ infoStr return True ExitFailure _ -> do pushLog LogLevelPrint infoStr
src/Development/Iridium/Hackage.hs view
@@ -19,9 +19,13 @@ import qualified Turtle as Turtle import System.Exit -import qualified Network.HTTP.Conduit as HTTP-import qualified Text.XmlHtml as Html+import qualified Network.HTTP as HTTP+import qualified Network.URI as URI import qualified Data.Text as Text+import qualified Data.Aeson as Aeson+import qualified Data.HashMap.Strict as HM+import qualified Text.ParserCombinators.ReadP as ReadP+import Data.List (find) import System.Process hiding ( cwd ) @@ -40,52 +44,39 @@ , MonadMultiState LogState m , MonadPlus m )- => String -> String -> m (Maybe String)+ => String -> String -> m (Maybe Version) retrieveLatestVersion remoteUrl pkgName = do let urlStr :: String = remoteUrl ++ "/package/" ++ pkgName ++ "/preferred" pushLog LogLevelInfo $ "Looking up latest version from hackage via url " ++ urlStr- -- url <- case URI.parseURI urlStr of- -- Nothing -> do- -- pushLog LogLevelError "bad URI"- -- mzero- -- Just u -> return u- -- result <- liftIO $ HTTP.simpleHTTP (HTTP.mkRequest HTTP.GET url)- -- rawHtml <- case result of- -- Left _ -> do- -- pushLog LogLevelError "Error: Could not retrieve hackage version"- -- mzero- -- Right x -> return $ HTTP.rspBody x - -- TODO: error handling+ uri <- case URI.parseURI urlStr of+ Nothing -> do+ pushLog LogLevelError "bad URI"+ mzero+ Just u -> return u+ let request = HTTP.insertHeader HTTP.HdrAccept "application/json"+ $ HTTP.mkRequest HTTP.GET uri - rawHtmlE <- liftIO $ try $ HTTP.simpleHttp urlStr- case rawHtmlE of- Left (_::HTTP.HttpException) -> return Nothing- Right rawHtml -> case Html.parseHTML "hackage:response"- $ ByteString.concat- $ ByteStringL.toChunks rawHtml of- Left e -> do- pushLog LogLevelError e+ rawHtmlE <- liftIO $ HTTP.simpleHTTP request+ let parseError = do+ pushLog LogLevelError "Could not decode hackage response." mzero- Right x -> do- let mStr = fmap (Text.unpack . Html.nodeText)- $ ( listToMaybe . Html.childNodes )- =<< listToMaybe- ( reverse- $ Html.descendantElementsTag (Text.pack "a")- ( head- $ Html.docContent- $ x- )- )- case mStr of- Nothing -> do- pushLog LogLevelError "Error: Could not decode hackage response."- mzero- Just s -> do- pushLog LogLevelInfoVerbose $ "got: " ++ s- return $ Just s+ case rawHtmlE of+ Left{} -> return Nothing+ Right r -> case Aeson.decode $ HTTP.rspBody r of+ Just m -> case HM.lookup (Text.pack "normal-version") m of+ Nothing -> parseError+ Just [] -> pure Nothing+ Just (vs :: [String]) -> do+ let v :: Version = maximum $ parseVersionF <$> vs+ pure $ Just v+ Nothing -> parseError+ where+ parseVersionF s = case find (null . snd) $ ReadP.readP_to_S parseVersion s of+ Nothing -> error "parseVersionF"+ Just (v, _) -> v + uploadPackage :: forall m . ( MonadIO m@@ -121,6 +112,28 @@ Nothing Nothing Nothing Nothing Nothing >>= waitForProcess pushLog LogLevelPrint "Upload successful."+ "cabal-new" -> do+ (PackageName pname) <- askPackageName+ pvers <- askPackageVersion+ username <- configReadStringMaybeM ["setup", "hackage", "username"]+ password <- configReadStringMaybeM ["setup", "hackage", "password"]++ let filePath = "dist/" ++ pname ++ "-" ++ showVersion pvers ++ ".tar.gz"+ mzeroIfNonzero $ liftIO $+ runProcess "cabal" ["sdist"] Nothing Nothing Nothing Nothing Nothing+ >>= waitForProcess+ mzeroIfNonzero $ liftIO $+ runProcess "cabal"+ ( [ "upload"+ , "--publish"+ , filePath+ ]+ ++ ["-u" ++ u | u <- maybeToList username]+ ++ ["-p" ++ p | p <- maybeToList password]+ )+ Nothing Nothing Nothing Nothing Nothing+ >>= waitForProcess+ pushLog LogLevelPrint "Upload successful." "stack" -> do pushLog LogLevelError "TODO: stack upload" mzero@@ -146,6 +159,7 @@ runProcess "cabal" ( [ "upload" , "--doc"+ , "--publish" ] ++ ["-u" ++ u | u <- maybeToList username] ++ ["-p" ++ p | p <- maybeToList password]@@ -157,4 +171,4 @@ "stack" -> do pushLog LogLevelError "TODO: stack upload" mzero- _ -> mzero+ _ -> error "uploadDocs not supported in cabal-new"