staversion 0.2.2.0 → 0.2.3.0
raw patch · 24 files changed
+651/−306 lines, 24 files
Files
- ChangeLog.md +8/−0
- README.md +27/−0
- src/Staversion/Internal/BuildPlan.hs +38/−49
- src/Staversion/Internal/BuildPlan/StackYaml.hs +0/−99
- src/Staversion/Internal/Command.hs +11/−2
- src/Staversion/Internal/EIO.hs +45/−0
- src/Staversion/Internal/Exec.hs +44/−19
- src/Staversion/Internal/Format.hs +11/−7
- src/Staversion/Internal/Query.hs +10/−3
- src/Staversion/Internal/StackConfig.hs +192/−0
- staversion.cabal +13/−6
- test/Staversion/Internal/BuildPlan/StackYamlSpec.hs +0/−42
- test/Staversion/Internal/BuildPlanSpec.hs +1/−1
- test/Staversion/Internal/CommandSpec.hs +12/−0
- test/Staversion/Internal/ExecSpec.hs +38/−1
- test/Staversion/Internal/StackConfigSpec.hs +86/−0
- test/data/stack/bar/bar.cabal +0/−0
- test/data/stack/foo/foo.cabal +0/−0
- test/data/stack/simple.cabal +20/−0
- test/data/stack/stack_complex_packages.yaml +7/−0
- test/data/stack/stack_empty_packages.yaml +5/−0
- test/data/stack/stack_multi.yaml +6/−0
- test/data/stack/stack_sample.yaml +77/−0
- test/data/stack_sample.yaml +0/−77
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for staversion +## 0.2.3.0 -- 2018-07-10++* Now it reads "stack.yaml" file as a query (#4).+* Now if no query argument is specified, "stack.yaml" is implied by default.+* Now it warns if it gets no result. This is necessary now that it's+ not an error to specify no query argument.++ ## 0.2.2.0 -- 2018-07-01 * Add `--stack` and `--stack-default` (`-S`) options (#4).
README.md view
@@ -76,6 +76,33 @@ (snip) +## Package version for stack projects++You can also specify stack.yaml file in the query. In that case, staversion reads its `packages` field and treats all .cabal files under those package directories as the query.++ $ staversion --hackage ./staversion/stack.yaml + ------ latest in hackage+ -- ./staversion/./staversion.cabal - library+ base ==4.11.1.0,+ unordered-containers ==0.2.9.0,+ aeson ==1.4.0.0,+ text ==1.2.3.0,+ + (snip)++"stack.yaml" in the query has a special meaning. It means the default stack.yaml of your current project. The "stack.yaml" does not have to be in the working directory. This query is implied by default if you pass no query arguments.++ $ staversion --hackage stack.yaml+ ------ latest in hackage+ -- /home/toshio/programs/git/staversion/./staversion.cabal - library+ base ==4.11.1.0,+ unordered-containers ==0.2.9.0,+ aeson ==1.4.0.0,+ text ==1.2.3.0,+ + (snip)++ ## Package version ranges over different resolvers With `--aggregate` (`-a`) option, you can aggregate version numbers in different resolvers into a version range using the given aggregation rule.
src/Staversion/Internal/BuildPlan.hs view
@@ -12,7 +12,7 @@ buildPlanSource, BuildPlanManager, newBuildPlanManager,- manStackCommand,+ manStackConfig, loadBuildPlan, -- * Low-level APIs BuildPlanMap,@@ -23,7 +23,6 @@ import Control.Applicative (empty, (<$>), (<*>)) import Control.Exception (throwIO, catchJust, IOException, catch)-import Control.Monad.Trans.Except (runExceptT, ExceptT(..)) import Control.Monad.IO.Class (liftIO) import Control.Monad (mapM) import Data.Aeson (FromJSON(..), (.:), Value(..), Object)@@ -42,6 +41,9 @@ import qualified System.IO.Error as IOE import Text.Read (readMaybe) +import Staversion.Internal.EIO+ ( EIO, maybeToEIO, runEIO, toEIO, loggedElse+ ) import Staversion.Internal.Log ( Logger, logDebug, logWarn )@@ -62,7 +64,8 @@ PartialResolver(..), ExactResolver(..), fetchBuildPlanYAML )-import qualified Staversion.Internal.BuildPlan.StackYaml as StackYaml+import Staversion.Internal.StackConfig (StackConfig)+import qualified Staversion.Internal.StackConfig as StackConfig import Staversion.Internal.BuildPlan.Version (unVersionJSON) import Staversion.Internal.Version (Version) @@ -115,9 +118,8 @@ -- ^ (accessor function) cache of resolver -- disambigutor manLogger :: Logger,- manStackCommand :: String- -- ^ (accessor function) Shell command for the- -- @stack@ tool.+ manStackConfig :: StackConfig+ -- ^ (accessor function) } newBuildPlanManager :: FilePath -- ^ path to the directory where build plans are hold.@@ -133,29 +135,14 @@ manHttpManager = mman, manDisambiguator = disam, manLogger = logger,- manStackCommand = "stack"+ manStackConfig = StackConfig.newStackConfig logger } -type LoadM = ExceptT ErrorMsg IO--loggedElse :: Logger- -> LoadM a -- ^ first action tried.- -> LoadM a -- ^ the action executed if the first action returns 'Left'.- -> LoadM a-loggedElse logger first second = ExceptT $ do- eret <- runExceptT first- case eret of- Right _ -> return eret- Left e -> logWarn logger e >> runExceptT second--maybeToLoadM :: ErrorMsg -> Maybe a -> LoadM a-maybeToLoadM msg = ExceptT . return . maybe (Left msg) Right--httpManagerM :: BuildPlanManager -> LoadM Manager-httpManagerM = maybeToLoadM "It is not allowed to access network." . manHttpManager+httpManagerM :: BuildPlanManager -> EIO Manager+httpManagerM = maybeToEIO "It is not allowed to access network." . manHttpManager -httpExceptionToLoadM :: String -> LoadM a -> LoadM a-httpExceptionToLoadM context action = ExceptT $ (runExceptT action) `catch` handler where+httpExceptionToEIO :: String -> EIO a -> EIO a+httpExceptionToEIO context action = toEIO $ (runEIO action) `catch` handler where handler :: OurHttpException -> IO (Either ErrorMsg a) handler e = return $ Left (context ++ ": " ++ show e) @@ -165,13 +152,16 @@ -> PackageSource -> IO (Either ErrorMsg BuildPlan) -- ^ the second result is the real (disambiguated) PackageSource.-loadBuildPlan man _ (SourceStackage resolver) = runExceptT impl where+loadBuildPlan man names s = runEIO $ loadBuildPlanM man names s++loadBuildPlanM :: BuildPlanManager -> [PackageName] -> PackageSource -> EIO BuildPlan+loadBuildPlanM man _ (SourceStackage resolver) = impl where impl = loadBuildPlan_stackageLocalFile man resolver `loggedElse'` do e_resolver <- tryDisambiguate man =<< getPresolver loadBuildPlan_stackageLocalFile man (formatExactResolverString e_resolver) `loggedElse'` loadBuildPlan_stackageNetwork man e_resolver- getPresolver = maybeToLoadM ("Invalid resolver format for stackage.org: " ++ resolver) $ parseResolverString resolver+ getPresolver = maybeToEIO ("Invalid resolver format for stackage.org: " ++ resolver) $ parseResolverString resolver loggedElse' = loggedElse $ manLogger man-loadBuildPlan man names SourceHackage = runExceptT impl where+loadBuildPlanM man names SourceHackage = impl where impl = do http_man <- httpManagerM man build_plan_map <- (mconcat . zipWith registeredVersionToBuildPlanMap names) <$> mapM (doFetch http_man) names@@ -180,24 +170,23 @@ logWarn' msg = liftIO $ logWarn (manLogger man) msg doFetch http_man name = do logDebug' ("Ask hackage for the latest version of " ++ unpack name)- reg_ver <- ExceptT $ fetchPreferredVersions http_man name+ reg_ver <- toEIO $ fetchPreferredVersions http_man name case latestVersion reg_ver of Nothing -> logWarn' ("Cannot find package version of " ++ unpack name ++ ". Maybe it's not on hackage.") Just _ -> return () return reg_ver-loadBuildPlan man names (SourceStackYaml file) = do- eresolver <- StackYaml.readResolver file- case eresolver of- Left err -> return $ Left err- Right resolver -> loadBuildPlan man names (SourceStackage resolver)-loadBuildPlan man names SourceStackDefault = do- efile <- StackYaml.configLocation (manLogger man) (manStackCommand man)- case efile of- Left err -> return $ Left err- Right f -> loadBuildPlan man names (SourceStackYaml f)+loadBuildPlanM man names (SourceStackYaml file) = loadBuildPlan_sourceStack man names $ Just file+loadBuildPlanM man names SourceStackDefault = loadBuildPlan_sourceStack man names $ Nothing -loadBuildPlan_stackageLocalFile :: BuildPlanManager -> Resolver -> LoadM BuildPlan-loadBuildPlan_stackageLocalFile man resolver = ExceptT $ catchJust handleIOError doLoad (return . Left) where+loadBuildPlan_sourceStack :: BuildPlanManager -> [PackageName] -> Maybe FilePath -> EIO BuildPlan+loadBuildPlan_sourceStack man names mfile = do+ resolver <- toEIO $ StackConfig.readResolver sconf mfile+ loadBuildPlanM man names $ SourceStackage resolver+ where+ sconf = manStackConfig man++loadBuildPlan_stackageLocalFile :: BuildPlanManager -> Resolver -> EIO BuildPlan+loadBuildPlan_stackageLocalFile man resolver = toEIO $ catchJust handleIOError doLoad (return . Left) where yaml_file = manBuildPlanDir man </> resolver <.> "yaml" doLoad = do logDebug (manLogger man) ("Read " ++ yaml_file ++ " for build plan.")@@ -210,12 +199,12 @@ | otherwise = Just $ makeErrorMsg e ("some error.") makeErrorMsg exception body = "Loading build plan for package resolver '" ++ resolver ++ "' failed: " ++ body ++ "\n" ++ show exception -tryDisambiguate :: BuildPlanManager -> PartialResolver -> LoadM ExactResolver+tryDisambiguate :: BuildPlanManager -> PartialResolver -> EIO ExactResolver tryDisambiguate _ (PartialExact e) = return e tryDisambiguate bp_man presolver = impl where impl = do- disam <- httpExceptionToLoadM "Failed to download disambiguator" $ getDisambiguator- maybeToLoadM ("Cannot disambiguate the resolver: " ++ show presolver) $ disam presolver+ disam <- httpExceptionToEIO "Failed to download disambiguator" $ getDisambiguator+ maybeToEIO ("Cannot disambiguate the resolver: " ++ show presolver) $ disam presolver getDisambiguator = do m_disam <- liftIO $ readIORef $ manDisambiguator bp_man case m_disam of@@ -223,18 +212,18 @@ Nothing -> do http_man <- httpManagerM bp_man logDebug' "Fetch resolver disambiguator from network..."- got_d <- ExceptT $ fetchDisambiguator http_man+ got_d <- toEIO $ fetchDisambiguator http_man logDebug' "Successfully fetched resolver disambiguator." liftIO $ writeIORef (manDisambiguator bp_man) $ Just got_d return got_d logDebug' = liftIO . logDebug (manLogger bp_man) -loadBuildPlan_stackageNetwork :: BuildPlanManager -> ExactResolver -> LoadM BuildPlan+loadBuildPlan_stackageNetwork :: BuildPlanManager -> ExactResolver -> EIO BuildPlan loadBuildPlan_stackageNetwork man e_resolver = do http_man <- httpManagerM man liftIO $ logDebug (manLogger man) ("Fetch build plan from network: resolver = " ++ show e_resolver)- yaml_data <- httpExceptionToLoadM ("Downloading build plan failed: " ++ show e_resolver) $ liftIO $ fetchBuildPlanYAML http_man e_resolver- makeBuildPlan <$> (ExceptT $ return $ parseBuildPlanMapYAML $ BSL.toStrict yaml_data)+ yaml_data <- httpExceptionToEIO ("Downloading build plan failed: " ++ show e_resolver) $ liftIO $ fetchBuildPlanYAML http_man e_resolver+ makeBuildPlan <$> (toEIO $ return $ parseBuildPlanMapYAML $ BSL.toStrict yaml_data) where makeBuildPlan bp_map = BuildPlan { buildPlanMap = bp_map, buildPlanSource = SourceStackage $ formatExactResolverString e_resolver
− src/Staversion/Internal/BuildPlan/StackYaml.hs
@@ -1,99 +0,0 @@--- |--- Module: Staversion.Internal.BuildPlan.StackYaml--- Description: Get PackageSource from stack.yaml--- Maintainer: Toshio Ito <debug.ito@gmail.com>------ __This is an internal module. End-users should not use it.__------ This module is meant to be exposed only to--- "Staversion.Internal.BuildPlan" and test modules.-module Staversion.Internal.BuildPlan.StackYaml- ( readResolver,- configLocation,- configLocationFromText- ) where--import Control.Applicative (empty, many, some)-import Control.Monad (void, when)-import Data.Char (isSpace)-import Data.Monoid ((<>))-import Data.Yaml (FromJSON(..), Value(..), (.:), decodeEither)-import Data.Text (Text, pack)-import qualified Data.Text as T-import qualified Data.ByteString as BS-import System.Exit (ExitCode(ExitFailure))-import System.Process- ( shell, readCreateProcessWithExitCode- )--import Staversion.Internal.Log (Logger, logWarn, logDebug)-import Staversion.Internal.Query (Resolver, ErrorMsg)-import Staversion.Internal.Megaparsec (Parser, runParser, satisfy, space)--newtype Resolver' = Resolver' { unResolver' :: Resolver }- deriving (Show,Eq,Ord)--instance FromJSON Resolver' where- parseJSON (Object o) = fmap Resolver' $ o .: "resolver"- parseJSON _ = empty---- | Read the @resolver@ field in stack.yaml.-readResolver :: FilePath -- ^ path to stack.yaml- -> IO (Either ErrorMsg Resolver)-readResolver file = fmap (fmap unResolver' . decodeEither) $ BS.readFile file---- | Get the path to stack.yaml that @stack@ uses as the current--- config.-configLocation :: Logger- -> String -- ^ shell command for @stack@- -> IO (Either ErrorMsg FilePath)-configLocation logger command = do- pout <- getProcessOutput logger command- case configLocationFromText =<< pout of- e@(Right path) -> logDebug logger ("Project stack config: " <> path) >> return e- e -> return e--getProcessOutput :: Logger -> String -> IO (Either ErrorMsg Text)-getProcessOutput logger command = handleResult =<< readCreateProcessWithExitCode cmd ""- where- cmd_str = command <> " path"- cmd = shell cmd_str- warnErr err = when (length err /= 0) $ logWarn logger err- handleResult (code, out, err) = do- case code of- ExitFailure c -> do- let code_err = "'" <> cmd_str <> "' returns non-zero exit code: " <> show c <> "."- hint = "It requires the 'stack' tool. Maybe you have to specify the command by --stack-command option."- logWarn logger code_err- warnErr err- return $ Left (code_err <> "\n" <> hint)- _ -> do- warnErr err- return $ Right $ pack out--configLocationFromText :: Text -> Either ErrorMsg FilePath-configLocationFromText input = toEither $ findField =<< T.lines input- where- fieldName = "config-location"- findField :: Text -> [FilePath]- findField line = do- (fname, fvalue) <- maybe [] return $ parseField line- if fname == fieldName- then return $ T.unpack fvalue- else []- toEither :: [FilePath] -> Either ErrorMsg FilePath- toEither [] = Left ("Cannot find '" <> T.unpack fieldName <> "' field in stack path")- toEither (r:_) = Right r- parseField :: Text -> Maybe (Text, Text)- parseField = either (const Nothing) return . runParser parser ""- parser :: Parser (Text,Text)- parser = do- space- fname <- term- void $ many $ satisfy isSep- fval <- term- return (fname, fval)- where- isSep c = c == ':' || isSpace c- term = fmap T.pack $ some $ satisfy (not . isSep)-
src/Staversion/Internal/Command.hs view
@@ -115,15 +115,24 @@ ++ " This option is implied if there is no options about package source (e.g. -r and -H)." ) ]- queries = some $ parseQuery <$> (query_package <|> query_cabal)+ queries = withDefault [QueryStackYamlDefault] $ many $ parseQuery <$> (query_package <|> query_cabal <|> query_stack_yaml) query_package = Opt.strArgument $ mconcat [ Opt.help "Name of package whose version you want to check.", Opt.metavar "PACKAGE_NAME" ] query_cabal = Opt.strArgument- $ mconcat [ Opt.help "(EXPERIMENTAL) .cabal file name. It checks versions of packages in build-deps lists.",+ $ mconcat [ Opt.help ".cabal file name. It checks versions of packages in build-deps lists.", Opt.metavar "CABAL_FILEPATH" ]+ query_stack_yaml = Opt.strArgument+ $ mconcat [ Opt.help ( "Path to stack.yaml file."+ ++ " It checks versions of packages in build-deps of all cabal projects listed in the stack.yaml."+ ++ " If you just type 'stack.yaml',"+ ++ " it means the default configuration that 'stack' command would use by default."+ ++ " 'stack.yaml' is implied if there is no query argument."+ ),+ Opt.metavar "STACK_YAML_FILEPATH"+ ] network = not <$> no_network no_network = Opt.switch $ mconcat [ Opt.long "no-network", Opt.help "Forbid network access."
+ src/Staversion/Internal/EIO.hs view
@@ -0,0 +1,45 @@+-- |+-- Module: Staversion.Internal.EIO+-- Description: +-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __This is an internal module. End-users should not use it.__+module Staversion.Internal.EIO+ ( EIO,+ runEIO,+ toEIO,+ loggedElse,+ maybeToEIO,+ eitherToEIO+ ) where++import Control.Monad.Trans.Except (runExceptT, ExceptT(..))++import Staversion.Internal.Log (Logger, logWarn)+import Staversion.Internal.Query (ErrorMsg)++type EIO = ExceptT ErrorMsg IO++runEIO :: EIO a -> IO (Either ErrorMsg a)+runEIO = runExceptT++toEIO :: IO (Either ErrorMsg a) -> EIO a+toEIO = ExceptT++loggedElse :: Logger+ -> EIO a -- ^ first action tried.+ -> EIO a -- ^ the action executed if the first action returns 'Left'.+ -> EIO a+loggedElse logger first second = ExceptT $ do+ eret <- runExceptT first+ case eret of+ Right _ -> return eret+ Left e -> logWarn logger e >> runExceptT second++maybeToEIO :: ErrorMsg -> Maybe a -> EIO a+maybeToEIO msg = ExceptT . return . maybe (Left msg) Right++eitherToEIO :: Either ErrorMsg a -> EIO a+eitherToEIO = ExceptT . return++
src/Staversion/Internal/Exec.hs view
@@ -13,6 +13,7 @@ import Control.Applicative ((<$>)) import Control.Monad (mapM_, when)+import Control.Monad.IO.Class (liftIO) import Data.Either (rights) import Data.Function (on) import Data.List (groupBy, nub)@@ -24,15 +25,16 @@ import Staversion.Internal.BuildPlan ( BuildPlan, packageVersion, buildPlanSource, newBuildPlanManager, loadBuildPlan,- BuildPlanManager, manStackCommand+ BuildPlanManager, manStackConfig ) import Staversion.Internal.Command ( parseCommandArgs, Command(..) )+import Staversion.Internal.EIO (EIO, runEIO, toEIO) import Staversion.Internal.Format (formatAggregatedResults) import qualified Staversion.Internal.Format as Format-import Staversion.Internal.Log (logDebug, logError, Logger, putLogEntry)+import Staversion.Internal.Log (logDebug, logError, logWarn, Logger, putLogEntry) import Staversion.Internal.Query ( Query(..), PackageSource(..), PackageName, ErrorMsg )@@ -41,6 +43,9 @@ singletonResult ) import Staversion.Internal.Cabal (BuildDepends(..), loadCabalFile)+import Staversion.Internal.StackConfig+ ( StackConfig, newStackConfig, scCommand, readProjectCabals+ ) main :: IO () main = do@@ -64,18 +69,24 @@ processCommand :: Command -> IO [Result] processCommand = _processCommandWithCustomBuildPlanManager return +stackConfigFromCommand :: Command -> StackConfig+stackConfigFromCommand comm = (newStackConfig $ commLogger comm) { scCommand = commStackCommand comm }+ makeBuildPlanManager :: Command -> IO BuildPlanManager makeBuildPlanManager comm = do man <- newBuildPlanManager (commBuildPlanDir comm) (commLogger comm) (commAllowNetwork comm)- return $ man { manStackCommand = commStackCommand comm }+ return $ man { manStackConfig = stackConfigFromCommand comm } _processCommandWithCustomBuildPlanManager :: (BuildPlanManager -> IO BuildPlanManager) -> Command -> IO [Result] _processCommandWithCustomBuildPlanManager customBPM comm = impl where impl = do bp_man <- customBPM =<< makeBuildPlanManager comm- query_pairs <- resolveQueries' logger $ commQueries comm- fmap concat $ mapM (processQueriesIn bp_man query_pairs) $ commSources comm+ query_pairs <- resolveQueries' logger stack_conf $ commQueries comm+ results <- fmap concat $ mapM (processQueriesIn bp_man query_pairs) $ commSources comm+ warnEmpty results+ return results logger = commLogger comm+ stack_conf = stackConfigFromCommand comm processQueriesIn bp_man query_pairs source = do let queried_names = nub $ concat $ map (getQueriedPackageNames) $ rights $ map snd $ query_pairs logDebug logger ("Retrieve package source " ++ show source)@@ -96,31 +107,45 @@ } logBuildPlanResult (Right _) = logDebug logger ("Successfully retrieved build plan.") logBuildPlanResult (Left error_msg) = logError logger ("Failed to load build plan: " ++ error_msg)+ warnEmpty [] = logWarn logger "Got no result. Try --help option."+ warnEmpty _ = return () realSource :: Either e BuildPlan -> Maybe PackageSource realSource (Left _) = Nothing realSource (Right bp) = Just $ buildPlanSource bp -resolveQueries' :: Logger -> [Query] -> IO [(Query, Either ErrorMsg ResolvedQuery)]-resolveQueries' logger = fmap concat . mapM resolveToList where+resolveQueries' :: Logger -> StackConfig -> [Query] -> IO [(Query, Either ErrorMsg ResolvedQuery)]+resolveQueries' logger sconf queries = fmap concat $ mapM resolveToList queries where resolveToList query = do- eret <- resolveQuery logger query+ eret <- resolveQuery logger sconf query case eret of Right rqueries -> return $ map (\rq -> (query, Right rq)) rqueries Left err -> return $ [(query, Left err)] -resolveQuery :: Logger -> Query -> IO (Either ErrorMsg [ResolvedQuery])-resolveQuery _ (QueryName name) = return $ Right $ [RQueryOne name]-resolveQuery logger (QueryCabalFile file) = do- logDebug logger ("Load " ++ file ++ " for build-depends fields.")- e_rquery <- (fmap . fmap) processBuildDependsList $ loadCabalFile file- reportError e_rquery- return e_rquery+resolveQuery :: Logger -> StackConfig -> Query -> IO (Either ErrorMsg [ResolvedQuery])+resolveQuery logger sconf query = reportError =<< (runEIO $ resolveQueryEIO logger sconf query) where- processBuildDependsList = map (RQueryCabal file) . filter ((0 <) . length . depsPackages)- reportError e_rquery = case e_rquery of- Left err -> logError logger err- Right _ -> return ()+ reportError eret = do+ case eret of+ Left err -> logError logger err+ Right _ -> return ()+ return eret++resolveQueryEIO :: Logger -> StackConfig -> Query -> EIO [ResolvedQuery]+resolveQueryEIO logger sconf query =+ case query of+ QueryName name -> return $ [RQueryOne name]+ QueryCabalFile file -> doCabalFile file+ QueryStackYaml file -> doStackYaml (Just file)+ QueryStackYamlDefault -> doStackYaml Nothing+ where+ doCabalFile file = do+ liftIO $ logDebug logger ("Load " ++ file ++ " for build-depends fields.")+ fmap (processBuildDependsList file) $ toEIO $ loadCabalFile file+ processBuildDependsList file = map (RQueryCabal file) . filter ((0 <) . length . depsPackages)+ doStackYaml mstack_yaml = fmap concat $ mapM recurse =<< (toEIO $ readProjectCabals sconf mstack_yaml)+ where+ recurse f = resolveQueryEIO logger sconf (QueryCabalFile f) searchVersions :: BuildPlan -> ResolvedQuery -> ResultBody searchVersions build_plan (RQueryOne package_name) = SimpleResultBody package_name $ packageVersion build_plan package_name
src/Staversion/Internal/Format.hs view
@@ -104,19 +104,23 @@ f ret (blocks, rlines) = case (aggResultFor ret, aggResultBody ret) of (_, Right (SimpleResultBody name mver)) -> (blocks, (versionLine (fconfFormatVersion fconf) name mver) : rlines) (_, Right (CabalResultBody file target pairs)) -> (cabalFileSuccessBlock fconf file target pairs : prependLines blocks rlines, [])- ((QueryName name), Left _) -> (blocks, (packageErrorLine name) : rlines)- ((QueryCabalFile file), Left _) -> (cabalFileErrorBlock file : prependLines blocks rlines, [])+ (query, Left _) -> case makeQueryErrorReport query of+ Left line -> (blocks, line : rlines)+ Right block -> (block : prependLines blocks rlines, []) versionLine :: FormatVersion -> PackageName -> Maybe VersionRange -> ResultLine versionLine _ name Nothing = Left $ "-- " <> fromText name <> " N/A" versionLine format_version name (Just ver_range) = Right $ fromText name <> " " <> (fromText $ format_version ver_range) -packageErrorLine :: PackageName -> ResultLine-packageErrorLine name = Left $ "-- " <> fromText name <> " ERROR"+makeQueryErrorReport :: Query -> Either ResultLine ResultBlock+makeQueryErrorReport (QueryName name) = Left $ Left $ "-- " <> fromText name <> " ERROR"+makeQueryErrorReport (QueryCabalFile file) = Right $ errorReportBlock file+makeQueryErrorReport (QueryStackYaml file) = Right $ errorReportBlock file+makeQueryErrorReport QueryStackYamlDefault = Right $ errorReportBlock "default stack.yaml" -cabalFileErrorBlock :: FilePath -> ResultBlock-cabalFileErrorBlock file = RBLines [Left line] where- line = "-- " <> fromString file <> " ERROR"+errorReportBlock :: String -> ResultBlock+errorReportBlock label = RBLines [Left line] where+ line = "-- " <> fromString label <> " ERROR" cabalFileSuccessBlock :: FormatConfig -> FilePath -> Target -> [(PackageName, Maybe VersionRange)] -> ResultBlock cabalFileSuccessBlock fconf file target pairs = RBHead header [RBLines $ map (uncurry $ versionLine $ fconfFormatVersion fconf) pairs] where
src/Staversion/Internal/Query.hs view
@@ -36,6 +36,8 @@ -- | Query for package version(s). data Query = QueryName PackageName | QueryCabalFile FilePath+ | QueryStackYaml FilePath+ | QueryStackYamlDefault deriving (Show,Eq,Ord) type ErrorMsg = String@@ -48,6 +50,11 @@ sourceDesc SourceStackDefault = "default stack resolver" parseQuery :: String -> Query-parseQuery s = if ".cabal" `isSuffixOf` s- then QueryCabalFile s- else QueryName $ pack s+parseQuery s =+ if s == "stack.yaml"+ then QueryStackYamlDefault+ else if "stack.yaml" `isSuffixOf` s+ then QueryStackYaml s+ else if ".cabal" `isSuffixOf` s+ then QueryCabalFile s+ else QueryName $ pack s
+ src/Staversion/Internal/StackConfig.hs view
@@ -0,0 +1,192 @@+-- |+-- Module: Staversion.Internal.StackConfig+-- Description: Central entity that deals with stack.yaml+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- __This is an internal module. End-users should not use it.__+module Staversion.Internal.StackConfig+ ( -- * StackConfig+ StackConfig,+ newStackConfig,+ scCommand,+ readResolver,+ readProjectCabals,+ -- * For tests+ configLocationFromText+ ) where++import Control.Applicative (empty, many, some, (<$>), (<*>))+import Control.Monad (void, when)+import Control.Monad.IO.Class (liftIO)+import Data.Char (isSpace)+import Data.List (isSuffixOf)+import Data.Monoid ((<>))+import Data.Yaml (FromJSON(..), Value(..), (.:), decodeEither)+import Data.Text (Text, pack)+import qualified Data.Text as T+import qualified Data.ByteString as BS+import System.Directory (getDirectoryContents)+import System.Exit (ExitCode(ExitFailure))+import System.FilePath ((</>), takeDirectory)+import System.Process+ ( shell, readCreateProcessWithExitCode+ )++import Staversion.Internal.EIO (EIO, toEIO, runEIO, eitherToEIO)+import Staversion.Internal.Log (Logger, logWarn, logDebug)+import Staversion.Internal.Query (Resolver, ErrorMsg)+import Staversion.Internal.Megaparsec (Parser, runParser, satisfy, space)+++-- | Central entity that deals with stack.yaml and @stack@ command.+data StackConfig =+ StackConfig+ { scCommand :: String,+ -- ^ (accessor) shell command for @stack@ tool.+ scLogger :: Logger+ }++newStackConfig :: Logger -> StackConfig+newStackConfig = StackConfig "stack"++-- | Element of @packages@ field. If the path is for the main project+-- (i.e. @extra-dep@ is false), it's 'Just'. Otherwise, it's+-- 'Nothing'.+newtype ProjectPath = ProjectPath (Maybe FilePath)+ deriving (Show,Eq,Ord)++instance FromJSON ProjectPath where+ parseJSON (String s) = return $ ProjectPath $ Just $ T.unpack s+ parseJSON (Object _) = return $ ProjectPath $ Nothing+ parseJSON _ = empty++-- | @stack.yaml@ content+data StackYaml =+ StackYaml+ { stackYamlPath :: FilePath,+ stackYamlResolver :: Resolver,+ stackYamlPackages :: [ProjectPath]+ }+ deriving (Show,Eq,Ord)++instance FromJSON StackYaml where+ parseJSON (Object o) = StackYaml "" <$> (o .: "resolver") <*> (o .: "packages")+ parseJSON _ = empty++readStackYaml :: FilePath -> EIO StackYaml+readStackYaml file = toEIO $ fmap (fmap setPath . decodeEither) $ BS.readFile file+ where+ setPath sy = sy { stackYamlPath = file }++findProjectCabal :: Logger -> FilePath -> ProjectPath -> IO [FilePath]+findProjectCabal _ _ (ProjectPath Nothing) = return []+findProjectCabal logger base_path (ProjectPath (Just project_path)) = do+ all_files <- getDirectoryContents project_fullpath+ let result_files = map (\f -> project_fullpath </> f) $ filter isCabalFile all_files+ when (length result_files == 0) $ do+ logWarn logger ("No .cabal file is found in " <> project_fullpath)+ return result_files+ where+ project_fullpath = base_path </> project_path+ isCabalFile :: FilePath -> Bool+ isCabalFile f = ".cabal" `isSuffixOf` f++findProjectCabals :: Logger+ -> StackYaml+ -> IO [FilePath] -- ^ paths to all project .cabal files.+findProjectCabals logger stack_yaml = do+ cabals <- fmap concat $ mapM (findProjectCabal logger base_path) packages+ warnEmpty cabals+ return cabals+ where+ stack_yaml_path = stackYamlPath stack_yaml+ base_path = takeDirectory $ stack_yaml_path+ packages = stackYamlPackages stack_yaml+ warnEmpty [] = logWarn logger ("No project .cabal files found in " <> stack_yaml_path)+ warnEmpty _ = return ()++readProjectCabals :: StackConfig+ -> Maybe FilePath+ -- ^ path to stack.yaml. If 'Nothing', the default stack.yaml is used.+ -> IO (Either ErrorMsg [FilePath])+ -- ^ paths to all .cabal files of the stack projects.+readProjectCabals s f = runEIO $ readProjectCabalsEIO s f++readProjectCabalsEIO :: StackConfig -> Maybe FilePath -> EIO [FilePath]+readProjectCabalsEIO sconf (Just stack_yaml_file) = do+ stack_yaml <- readStackYaml stack_yaml_file+ liftIO $ findProjectCabals logger stack_yaml+ where+ logger = scLogger sconf+readProjectCabalsEIO sconf Nothing = do+ stack_yaml_file <- configLocation sconf+ readProjectCabalsEIO sconf $ Just stack_yaml_file++-- | Read the @resolver@ field in stack.yaml.+readResolver :: StackConfig+ -> Maybe FilePath+ -- ^ path to stack.yaml. If 'Nothing', the default stack.yaml is used.+ -> IO (Either ErrorMsg Resolver)+readResolver sconf mfile = runEIO $ case mfile of+ Just file -> doRead file+ Nothing -> doRead =<< configLocation sconf+ where+ doRead file = fmap stackYamlResolver $ readStackYaml file++-- | Get the path to stack.yaml that @stack@ uses as the current+-- config.+configLocation :: StackConfig -> EIO FilePath+configLocation sconfig = do+ pout <- getProcessOutput sconfig+ path <- eitherToEIO $ configLocationFromText pout+ liftIO $ logDebug logger ("Project stack config: " <> path)+ return path+ where+ logger = scLogger sconfig++getProcessOutput :: StackConfig -> EIO Text+getProcessOutput sconfig = toEIO $ handleResult =<< readCreateProcessWithExitCode cmd ""+ where+ logger = scLogger sconfig+ command = scCommand sconfig+ cmd_str = command <> " path"+ cmd = shell cmd_str+ warnErr err = when (length err /= 0) $ logWarn logger err+ handleResult (code, out, err) = do+ case code of+ ExitFailure c -> do+ let code_err = "'" <> cmd_str <> "' returns non-zero exit code: " <> show c <> "."+ hint = "It requires the 'stack' tool. Maybe you have to specify the command by --stack-command option."+ logWarn logger code_err+ warnErr err+ return $ Left (code_err <> "\n" <> hint)+ _ -> do+ warnErr err+ return $ Right $ pack out++configLocationFromText :: Text -> Either ErrorMsg FilePath+configLocationFromText input = toEither $ findField =<< T.lines input+ where+ fieldName = "config-location"+ findField :: Text -> [FilePath]+ findField line = do+ (fname, fvalue) <- maybe [] return $ parseField line+ if fname == fieldName+ then return $ T.unpack fvalue+ else []+ toEither :: [FilePath] -> Either ErrorMsg FilePath+ toEither [] = Left ("Cannot find '" <> T.unpack fieldName <> "' field in stack path")+ toEither (r:_) = Right r+ parseField :: Text -> Maybe (Text, Text)+ parseField = either (const Nothing) return . runParser parser ""+ parser :: Parser (Text,Text)+ parser = do+ space+ fname <- term+ void $ many $ satisfy isSep+ fval <- term+ return (fname, fval)+ where+ isSep c = c == ':' || isSpace c+ term = fmap T.pack $ some $ satisfy (not . isSep)+
staversion.cabal view
@@ -1,5 +1,5 @@ name: staversion-version: 0.2.2.0+version: 0.2.3.0 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -21,7 +21,13 @@ test/data/conduit.cabal_test, test/data/foobar.cabal_test, test/data/braces.cabal_test,- test/data/stack_sample.yaml+ test/data/stack/simple.cabal,+ test/data/stack/stack_complex_packages.yaml,+ test/data/stack/foo/foo.cabal,+ test/data/stack/bar/bar.cabal,+ test/data/stack/stack_multi.yaml,+ test/data/stack/stack_sample.yaml,+ test/data/stack/stack_empty_packages.yaml homepage: https://github.com/debug-ito/staversion bug-reports: https://github.com/debug-ito/staversion/issues@@ -34,7 +40,6 @@ other-extensions: CPP, DeriveDataTypeable, TupleSections exposed-modules: Staversion.Internal.BuildPlan, Staversion.Internal.BuildPlan.Stackage,- Staversion.Internal.BuildPlan.StackYaml, Staversion.Internal.BuildPlan.Hackage, Staversion.Internal.BuildPlan.Version, Staversion.Internal.Query,@@ -45,10 +50,12 @@ Staversion.Internal.Exec, Staversion.Internal.Format, Staversion.Internal.Aggregate,- Staversion.Internal.Version+ Staversion.Internal.Version,+ Staversion.Internal.StackConfig other-modules: Paths_staversion, Staversion.Internal.HTTP,- Staversion.Internal.Megaparsec+ Staversion.Internal.Megaparsec,+ Staversion.Internal.EIO build-depends: base >=4.8 && <4.12, unordered-containers >=0.2.3 && <0.3, aeson >=0.8.0 && <1.5,@@ -93,7 +100,7 @@ Staversion.Internal.BuildPlan.StackageSpec, Staversion.Internal.BuildPlan.HackageSpec, Staversion.Internal.BuildPlan.VersionSpec,- Staversion.Internal.BuildPlan.StackYamlSpec,+ Staversion.Internal.StackConfigSpec, Staversion.Internal.ExecSpec, Staversion.Internal.FormatSpec, Staversion.Internal.CabalSpec,
− test/Staversion/Internal/BuildPlan/StackYamlSpec.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}-module Staversion.Internal.BuildPlan.StackYamlSpec (main,spec) where--import Data.Text (Text)-import Test.Hspec-import Text.Heredoc (here)--import Staversion.Internal.BuildPlan.StackYaml (configLocationFromText)--main :: IO ()-main = hspec spec--spec :: Spec-spec = describe "configLocationFromText" $ do- it "should load config-location field" $ do- configLocationFromText sample `shouldBe` Right "/home/debugito/programs/git/staversion/stack.yaml"--sample :: Text-sample = [here|stack-root: /home/debugito/.stack-project-root: /home/debugito/programs/git/staversion-config-location: /home/debugito/programs/git/staversion/stack.yaml-bin-path: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/bin:/home/debugito/.stack/compiler-tools/x86_64-linux/ghc-8.2.2/bin:/home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin:/home/debugito/.plenv/shims:/home/debugito/.plenv/bin:/opt/gradle/bin:/home/debugito/.local/bin:/home/debugito/gems/bin:/home/debugito/perl5/bin:/home/debugito/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin-programs: /home/debugito/.stack/programs/x86_64-linux-compiler-exe: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin/ghc-compiler-bin: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin-compiler-tools-bin: /home/debugito/.stack/compiler-tools/x86_64-linux/ghc-8.2.2/bin-local-bin: /home/debugito/.local/bin-extra-include-dirs: -extra-library-dirs: -snapshot-pkg-db: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/pkgdb-local-pkg-db: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/pkgdb-global-pkg-db: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/lib/ghc-8.2.2/package.conf.d-ghc-package-path: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/pkgdb:/home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/pkgdb:/home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/lib/ghc-8.2.2/package.conf.d-snapshot-install-root: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2-local-install-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2-snapshot-doc-root: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/doc-local-doc-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/doc-dist-dir: .stack-work/dist/x86_64-linux/Cabal-2.0.1.0-local-hpc-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/hpc-local-bin-path: /home/debugito/.local/bin-ghc-paths: /home/debugito/.stack/programs/x86_64-linux-|]
test/Staversion/Internal/BuildPlanSpec.hs view
@@ -78,6 +78,6 @@ buildPlanSource bp `shouldBe` SourceStackage "lts-4.2" it "reads the given stack.yaml for resolver" $ do bp_man <- mockBuildPlanManager 4 2- bp <- expRight =<< loadBuildPlan bp_man [] (SourceStackYaml ("test" </> "data" </> "stack_sample.yaml"))+ bp <- expRight =<< loadBuildPlan bp_man [] (SourceStackYaml ("test" </> "data" </> "stack" </> "stack_sample.yaml")) packageVersion bp "optparse-applicative" `shouldBe` (Just $ ver [0,12,0,0]) buildPlanSource bp `shouldBe` SourceStackage "lts-4.2"
test/Staversion/Internal/CommandSpec.hs view
@@ -23,3 +23,15 @@ (Just com) <- _parseCommandStrings ["-r", "lts-10", "base"] commQueries com `shouldBe` [QueryName "base"] commSources com `shouldBe` [SourceStackage "lts-10"]+ it "should treat plain stack.yaml as QueryStackYamlDefault" $ do+ (Just com) <- _parseCommandStrings ["stack.yaml"]+ commQueries com `shouldBe` [QueryStackYamlDefault]+ it "should treat stack.yaml with directory delimiter as QueryStackYaml" $ do+ (Just com) <- _parseCommandStrings ["./stack.yaml"]+ commQueries com `shouldBe` [QueryStackYaml "./stack.yaml"]+ it "should treat *.cabal as QueryCabalFile" $ do+ (Just com) <- _parseCommandStrings ["foobar.cabal"]+ commQueries com `shouldBe` [QueryCabalFile "foobar.cabal"]+ it "should use QueryStackYamlDefault if there is no query argument" $ do+ (Just com) <- _parseCommandStrings []+ commQueries com `shouldBe` [QueryStackYamlDefault]
test/Staversion/Internal/ExecSpec.hs view
@@ -111,7 +111,44 @@ ] ] processCommand comm `shouldReturn` expected- + specify "QueryStackYaml, SourceStackYaml" $ do+ let stack_yaml = "test" </> "data" </> "stack" </> "stack_sample.yaml"+ source = SourceStackYaml stack_yaml+ real_source = SourceStackage "lts-4.2"+ query = QueryStackYaml stack_yaml+ comm = baseCommand { commQueries = [query],+ commSources = [source]+ }+ exp_cabal_file = "test" </> "data" </> "stack" </> "." </> "simple.cabal"+ expRBody pairs = CabalResultBody exp_cabal_file TargetLibrary $ verPairs pairs+ expected = Result { resultIn = ResultSource source (Just real_source),+ resultFor = query,+ resultBody = Right $ expRBody+ [ ("base", [4,8,2,0]),+ ("hashable", [1,2,4,0]),+ ("parsers", [0,12,3])+ ]+ }+ got_results <- processCommand comm+ got_results `shouldBe` [expected]+ specify "QueryStackYaml (no packages), SourceStackage" $ do+ (logger, logs) <- _mockLogger+ let stack_yaml = "test" </> "data" </> "stack" </> "stack_empty_packages.yaml"+ source = SourceStackage "conpact_build_plan"+ query = QueryStackYaml stack_yaml+ comm = baseCommand { commQueries = [query],+ commSources = [source],+ commLogger = logger+ }+ got <- processCommand comm+ got `shouldBe` []+ let match :: LogEntry -> Bool+ match ent = (level == LogWarn) && ("no result" `isInfixOf` msg) && ("Try --help" `isInfixOf` msg)+ where+ level = logLevel ent+ msg = logMessage ent+ got_logs <- readIORef logs+ (length $ filter match got_logs) `shouldBe` 1 singleCase :: PackageSource -> Query -> Either ErrorMsg ResultBody -> IO () singleCase src query exp_ret_vers = singleCase' src query (`shouldBe` exp_ret_vers)
+ test/Staversion/Internal/StackConfigSpec.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}+module Staversion.Internal.StackConfigSpec (main,spec) where++import Data.IORef (IORef, readIORef)+import Data.Text (Text)+import System.FilePath ((</>))+import Test.Hspec+import Text.Heredoc (here)++import Staversion.Internal.Log+ ( LogEntry(..), _mockLogger, LogLevel(..), logLevel+ )+import Staversion.Internal.StackConfig+ ( StackConfig,+ configLocationFromText,+ newStackConfig,+ readProjectCabals+ )++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "configLocationFromText" $ do+ it "should load config-location field" $ do+ configLocationFromText sample `shouldBe` Right "/home/debugito/programs/git/staversion/stack.yaml"+ spec_readProjectCabals+ ++sample :: Text+sample = [here|stack-root: /home/debugito/.stack+project-root: /home/debugito/programs/git/staversion+config-location: /home/debugito/programs/git/staversion/stack.yaml+bin-path: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/bin:/home/debugito/.stack/compiler-tools/x86_64-linux/ghc-8.2.2/bin:/home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin:/home/debugito/.plenv/shims:/home/debugito/.plenv/bin:/opt/gradle/bin:/home/debugito/.local/bin:/home/debugito/gems/bin:/home/debugito/perl5/bin:/home/debugito/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin+programs: /home/debugito/.stack/programs/x86_64-linux+compiler-exe: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin/ghc+compiler-bin: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/bin+compiler-tools-bin: /home/debugito/.stack/compiler-tools/x86_64-linux/ghc-8.2.2/bin+local-bin: /home/debugito/.local/bin+extra-include-dirs: +extra-library-dirs: +snapshot-pkg-db: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/pkgdb+local-pkg-db: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/pkgdb+global-pkg-db: /home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/lib/ghc-8.2.2/package.conf.d+ghc-package-path: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/pkgdb:/home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/pkgdb:/home/debugito/.stack/programs/x86_64-linux/ghc-8.2.2/lib/ghc-8.2.2/package.conf.d+snapshot-install-root: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2+local-install-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2+snapshot-doc-root: /home/debugito/.stack/snapshots/x86_64-linux/lts-10.8/8.2.2/doc+local-doc-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/doc+dist-dir: .stack-work/dist/x86_64-linux/Cabal-2.0.1.0+local-hpc-root: /home/debugito/programs/git/staversion/.stack-work/install/x86_64-linux/lts-10.8/8.2.2/hpc+local-bin-path: /home/debugito/.local/bin+ghc-paths: /home/debugito/.stack/programs/x86_64-linux+|]++stackConfigForTest :: IO (StackConfig, IORef [LogEntry])+stackConfigForTest = do+ (logger, logs) <- _mockLogger+ return (newStackConfig logger, logs)++gotLogs :: LogLevel -> IORef [LogEntry] -> IO [LogEntry]+gotLogs threshold logs = do+ got_logs <- readIORef logs+ return $ filter ((>= threshold) . logLevel) got_logs++spec_readProjectCabals :: Spec+spec_readProjectCabals = describe "readProjectCabals" $ do+ let base_dir = "test" </> "data" </> "stack"+ specify "simple" $ do+ (sconf, logs) <- stackConfigForTest+ got <- readProjectCabals sconf $ Just (base_dir </> "stack_sample.yaml")+ got `shouldBe` Right [base_dir </> "." </> "simple.cabal"]+ gotLogs LogWarn logs `shouldReturn` []+ specify "multiple projects" $ do+ (sconf, logs) <- stackConfigForTest+ got <- readProjectCabals sconf $ Just (base_dir </> "stack_multi.yaml")+ got `shouldBe` Right [ base_dir </> "bar" </> "bar.cabal",+ base_dir </> "foo" </> "foo.cabal"+ ]+ gotLogs LogWarn logs `shouldReturn` []+ specify "complex packages field" $ do+ (sconf, logs) <- stackConfigForTest+ got <- readProjectCabals sconf $ Just (base_dir </> "stack_complex_packages.yaml")+ got `shouldBe` Right [base_dir </> "foo" </> "foo.cabal"]+ gotLogs LogWarn logs `shouldReturn` []
+ test/data/stack/bar/bar.cabal view
+ test/data/stack/foo/foo.cabal view
+ test/data/stack/simple.cabal view
@@ -0,0 +1,20 @@+name: simple+version: 0.1.2.0+author: Toshio Ito <debug.ito@gmail.com>+maintainer: Toshio Ito <debug.ito@gmail.com>+license: BSD3+license-file: LICENSE+synopsis: simple+description: simple test file+category: Example+cabal-version: >= 1.10+build-type: Simple+ +library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -fno-warn-unused-imports+ build-depends: base >=4.6 && <4.10,+ hashable,+ parsers+
+ test/data/stack/stack_complex_packages.yaml view
@@ -0,0 +1,7 @@+resolver: lts-11.2+packages:+- foo+- location: bar+ extra-dep: true+- location: .+ extra-dep: true
+ test/data/stack/stack_empty_packages.yaml view
@@ -0,0 +1,5 @@+resolver: lts-10.1+packages: []+extra-deps: []+flags: {}+extra-package-dbs: []
+ test/data/stack/stack_multi.yaml view
@@ -0,0 +1,6 @@+resolver: lts-10.2++packages:+- bar+- foo+
+ test/data/stack/stack_sample.yaml view
@@ -0,0 +1,77 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# https://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+# name: custom-snapshot+# location: "./custom-snapshot.yaml"+resolver: lts-4.2++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+# git: https://github.com/commercialhaskell/stack.git+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# extra-dep: true+# subdirs:+# - auto-update+# - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- .++# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++#### confirmed on 2018-03-12+## - aeson-1.3.0.0+## - QuickCheck-2.11.3+## - doctest-0.14.1+## - text-1.2.3.0+## - hspec-core-2.4.8+## - hspec-2.4.8+## - hspec-discover-2.4.8+## - hspec-expectations-0.8.2++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.5"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
− test/data/stack_sample.yaml
@@ -1,77 +0,0 @@-# This file was automatically generated by 'stack init'-#-# Some commonly used options have been documented as comments in this file.-# For advanced use and comprehensive documentation of the format, please see:-# https://docs.haskellstack.org/en/stable/yaml_configuration/--# Resolver to choose a 'specific' stackage snapshot or a compiler version.-# A snapshot resolver dictates the compiler version and the set of packages-# to be used for project dependencies. For example:-#-# resolver: lts-3.5-# resolver: nightly-2015-09-21-# resolver: ghc-7.10.2-# resolver: ghcjs-0.1.0_ghc-7.10.2-# resolver:-# name: custom-snapshot-# location: "./custom-snapshot.yaml"-resolver: lts-4.2--# User packages to be built.-# Various formats can be used as shown in the example below.-#-# packages:-# - some-directory-# - https://example.com/foo/bar/baz-0.0.2.tar.gz-# - location:-# git: https://github.com/commercialhaskell/stack.git-# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a-# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a-# extra-dep: true-# subdirs:-# - auto-update-# - wai-#-# A package marked 'extra-dep: true' will only be built if demanded by a-# non-dependency (i.e. a user package), and its test suites and benchmarks-# will not be run. This is useful for tweaking upstream packages.-packages:-- .--# Dependency packages to be pulled from upstream that are not in the resolver-# (e.g., acme-missiles-0.3)-extra-deps: []--#### confirmed on 2018-03-12-## - aeson-1.3.0.0-## - QuickCheck-2.11.3-## - doctest-0.14.1-## - text-1.2.3.0-## - hspec-core-2.4.8-## - hspec-2.4.8-## - hspec-discover-2.4.8-## - hspec-expectations-0.8.2--# Override default flag values for local packages and extra-deps-flags: {}--# Extra package databases containing global packages-extra-package-dbs: []--# Control whether we use the GHC we find on the path-# system-ghc: true-#-# Require a specific version of stack, using version ranges-# require-stack-version: -any # Default-# require-stack-version: ">=1.5"-#-# Override the architecture used by stack, especially useful on Windows-# arch: i386-# arch: x86_64-#-# Extra directories used by stack for building-# extra-include-dirs: [/path/to/dir]-# extra-lib-dirs: [/path/to/dir]-#-# Allow a newer minor version of GHC than the snapshot specifies-# compiler-check: newer-minor